home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / demosrc / cfsource / dentro1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-22  |  78.6 KB  |  3,253 lines
  1. {$D-,G+,R-,S-}
  2. PROGRAM PaletteStars;
  3. USES
  4.     Dos,MCGA,Font1,Font2,Gfx1,Gfx2;
  5. CONST
  6.      TextData:ARRAY[0..364,0..15] OF Char=(
  7.      '                ',
  8.      '                ',
  9.      '                ',
  10.      '                ',
  11.      'NOW THE CREDITS:',
  12.      '----------------',
  13.      '                ',
  14.      'CODE - THE FAKER',
  15.      '                ',
  16.      'GFX  - ORTHOMAN ',
  17.      '     - SAND AND ',
  18.      '       THE FAKER',
  19.      '----------------',
  20.      '                ',
  21.      'AND THE GREETS: ',
  22.      '                ',
  23.      '     GROUPS:    ',
  24.      '----------------',
  25.      '                ',
  26.      'AVALANCHE       ',
  27.      '                ',
  28.      '  BITCH         ',
  29.      '                ',
  30.      '    CASCADA     ',
  31.      '                ',
  32.      '      DUST      ',
  33.      '                ',
  34.      '        EMF     ',
  35.      '                ',
  36.      '          EPICAL',
  37.      '                ',
  38.      'EXTREME         ',
  39.      '                ',
  40.      '  ICE           ',
  41.      '                ',
  42.      '    IGUANA      ',
  43.      '                ',
  44.      '      IMPHOBIA  ',
  45.      '                ',
  46.      '        INFINITY',
  47.      '                ',
  48.      'LAST VISION     ',
  49.      '                ',
  50.      '  LEGEND DESIGN ',
  51.      '                ',
  52.      '    MAJIC 12 PC ',
  53.      '                ',
  54.      'MENTAL DESIGN   ',
  55.      '                ',
  56.      '  ONYX          ',
  57.      '                ',
  58.      '    PENTAGON    ',
  59.      '                ',
  60.      '      SILENTS PC',
  61.      '                ',
  62.      '        SONIC   ',
  63.      '                ',
  64.      'SURPRISE ! PROD.',
  65.      '                ',
  66.      '  SMA POSSE     ',
  67.      '                ',
  68.      '    TEI         ',
  69.      '                ',
  70.      '      TRITON    ',
  71.      '                ',
  72.      'ULTRAFORCE      ',
  73.      '                ',
  74.      '  VLA           ',
  75.      '                ',
  76.      '    WITAN       ',
  77.      '                ',
  78.      '      XOGRAPHY  ',
  79.      '----------------',
  80.      '                ',
  81.      '   PERSONAL:    ',
  82.      '----------------',
  83.      '                ',
  84.      'ALL GIRLS AROUND',
  85.      '                ',
  86.      '     ALIEN      ',
  87.      '                ',
  88.      '  ALPHA - AXL   ',
  89.      '                ',
  90.      ' ANTIBYTE - S!P ',
  91.      '                ',
  92.      'ANTITRACK - AARD',
  93.      '                ',
  94.      '     AVATAR     ',
  95.      '                ',
  96.      '     AXXON      ',
  97.      '                ',
  98.      '   AYM - PPLK   ',
  99.      '                ',
  100.      '     BABUU      ',
  101.      '                ',
  102.      '    BARFMAN     ',
  103.      '                ',
  104.      '    BIG HURT    ',
  105.      '                ',
  106.      '   BIT BLAZER   ',
  107.      '                ',
  108.      '    BOURBON     ',
  109.      '                ',
  110.      '     BROKER     ',
  111.      '                ',
  112.      '     BUUUD      ',
  113.      '                ',
  114.      ' BURNING CHROME ',
  115.      '                ',
  116.      '      BYTE      ',
  117.      '                ',
  118.      '    CAROLYN     ',
  119.      '                ',
  120.      '  CAPTAIN BIT   ',
  121.      '                ',
  122.      ' CASTERO - PPLK ',
  123.      '                ',
  124.      'CHICKEN - PENTA ',
  125.      '                ',
  126.      '     CLIPIT     ',
  127.      '                ',
  128.      '  CODY - AARD   ',
  129.      '                ',
  130.      '    COOLCAT     ',
  131.      '                ',
  132.      '     CRONOS     ',
  133.      '                ',
  134.      'CYBERSTRIKE - AV',
  135.      '                ',
  136.      '     DARION     ',
  137.      '                ',
  138.      '      DAX       ',
  139.      '                ',
  140.      '  DECKO - VLA   ',
  141.      '                ',
  142.      'DELPH - AARDVARK',
  143.      '                ',
  144.      '    DRAKHAI     ',
  145.      '                ',
  146.      '   DR. SLUDGE   ',
  147.      '                ',
  148.      'DUX - AVALANCHE ',
  149.      '                ',
  150.      ' DYNABYTE - TEI ',
  151.      '                ',
  152.      '     DUMDI      ',
  153.      '                ',
  154.      ' EPICMAN - AARD ',
  155.      '                ',
  156.      '     ERRAND     ',
  157.      '                ',
  158.      '     FAKEII     ',
  159.      '                ',
  160.      'FANTOMAS - PPLK ',
  161.      '                ',
  162.      '     FISCH      ',
  163.      '                ',
  164.      '   FIST - IA    ',
  165.      '                ',
  166.      '      FREQ      ',
  167.      '                ',
  168.      '     FUZZY      ',
  169.      '                ',
  170.      '     GLITCH     ',
  171.      '                ',
  172.      '    GLOGULUS    ',
  173.      '                ',
  174.      '   GORE - FC    ',
  175.      '                ',
  176.      '   GRAYGHOST    ',
  177.      '                ',
  178.      '   GRINDCORE    ',
  179.      '                ',
  180.      '     HACKER     ',
  181.      '                ',
  182.      '   HEADCRASH    ',
  183.      '                ',
  184.      ' HENCHMAN - FC  ',
  185.      '                ',
  186.      '      HERP      ',
  187.      '                ',
  188.      'INFILTRATOR - AA',
  189.      '                ',
  190.      '   JAKE - FC    ',
  191.      '                ',
  192.      ' JCAB - IGUANA  ',
  193.      '                ',
  194.      '  J.O.E. - S!P  ',
  195.      '                ',
  196.      '    KCJONES     ',
  197.      '                ',
  198.      'LEINAD - AVALAN ',
  199.      '                ',
  200.      'LEVIATHAN - SEL ',
  201.      '                ',
  202.      'LORD GOD XEROBE ',
  203.      '                ',
  204.      'LORD LOGICS - AV',
  205.      '                ',
  206.      '    MADMAX 1    ',
  207.      '                ',
  208.      'MAHLZAHN - PENTA',
  209.      '                ',
  210.      '   MAINFRAME    ',
  211.      '                ',
  212.      '    MARFADA9    ',
  213.      '                ',
  214.      '    MEGAFORK    ',
  215.      '                ',
  216.      'METAL HEAD - ICE',
  217.      '                ',
  218.      'MIGUEL INDURAIN ',
  219.      '                ',
  220.      '      MLVC      ',
  221.      '                ',
  222.      ' MORPHEUS - ICE ',
  223.      '                ',
  224.      'MOSTLY HARMLESS ',
  225.      '                ',
  226.      ' MR. DESTROYER  ',
  227.      '                ',
  228.      '  MR. FANATIC   ',
  229.      '                ',
  230.      '     MRFBOT     ',
  231.      '                ',
  232.      '      MUBA      ',
  233.      '                ',
  234.      'NOCTURNUS - INF ',
  235.      '                ',
  236.      '      NOT       ',
  237.      '                ',
  238.      '     NRRPF      ',
  239.      '                ',
  240.      '   OS - BITCH   ',
  241.      '                ',
  242.      'ORTHOMAN - AARD ',
  243.      '                ',
  244.      '     OZONE      ',
  245.      '                ',
  246.      'OZYMANDIA - AARD',
  247.      '                ',
  248.      '     PATCH      ',
  249.      '                ',
  250.      '   PECI - S!P   ',
  251.      '                ',
  252.      '     PELUSA     ',
  253.      '                ',
  254.      '     PENGO      ',
  255.      '                ',
  256.      '     PENMAN     ',
  257.      '                ',
  258.      '   PICHATORO    ',
  259.      '                ',
  260.      '    PIERCER     ',
  261.      '                ',
  262.      '     PRESTO     ',
  263.      '                ',
  264.      '      PRU2      ',
  265.      '                ',
  266.      '      PRU3      ',
  267.      '                ',
  268.      '     RANIK      ',
  269.      '                ',
  270.      '  RAPSCALLION   ',
  271.      '                ',
  272.      '  REEBOK - S!P  ',
  273.      '                ',
  274.      'RENEGADE BITHEAD',
  275.      '                ',
  276.      ' RICK DANGEROUS ',
  277.      '                ',
  278.      '   RIVERWIND    ',
  279.      '                ',
  280.      ' RUNNER - AARD  ',
  281.      '                ',
  282.      '      RWB       ',
  283.      '                ',
  284.      '      SAND      ',
  285.      '                ',
  286.      '   SHADDAM IV   ',
  287.      '                ',
  288.      '     SHARPB     ',
  289.      '                ',
  290.      '     SIRINE     ',
  291.      '                ',
  292.      '   SLAUGHTER    ',
  293.      '                ',
  294.      '    SMARTIE     ',
  295.      '                ',
  296.      'SOUL REBEL - AV ',
  297.      '                ',
  298.      '     SPEEDY     ',
  299.      '                ',
  300.      '  SPIKE - S!P   ',
  301.      '                ',
  302.      '     SQUIZ      ',
  303.      '                ',
  304.      '      TAB       ',
  305.      '                ',
  306.      '      TDK       ',
  307.      '                ',
  308.      '     TENAR      ',
  309.      '                ',
  310.      '   TERMX - IA   ',
  311.      '                ',
  312.      '    THE FOX     ',
  313.      '                ',
  314.      'THE GUILD MASTER',
  315.      '                ',
  316.      '   THE KABAL    ',
  317.      '                ',
  318.      ' THE KNIGHT ORC ',
  319.      '                ',
  320.      '     TIKES      ',
  321.      '                ',
  322.      '      TILT      ',
  323.      '                ',
  324.      '    TONEDEF     ',
  325.      '                ',
  326.      '   TRAVELLER    ',
  327.      '                ',
  328.      '     TRONIX     ',
  329.      '                ',
  330.      '   TRUG - FC    ',
  331.      '                ',
  332.      '     VINIT      ',
  333.      '                ',
  334.      ' VOLVOX - PPLK  ',
  335.      '                ',
  336.      '     WAMSY      ',
  337.      '                ',
  338.      '  WAR DOG - LV  ',
  339.      '                ',
  340.      ' WILDFIRE - FC  ',
  341.      '                ',
  342.      '   WREAM - AV   ',
  343.      '                ',
  344.      '     X-RAY      ',
  345.      '                ',
  346.      'ZAX - AVALANCHE ',
  347.      '                ',
  348.      '      ZEUS      ',
  349.      '                ',
  350.      '     ZIGZAG     ',
  351.      '                ',
  352.      'ZYRIX - EXTREME ',
  353.      '----------------',
  354.      '                ',
  355.      '  END OF TEXT   ',
  356.      '                ',
  357.      '                ',
  358.      '                ',
  359.      '                ',
  360.      '                ',
  361.      '                ',
  362.      '                ',
  363.      '                ',
  364.      '                ',
  365.      '                ',
  366.      '                ',
  367.      '                ',
  368.      '                ',
  369.      '                ',
  370.      '                ',
  371.      '                ');
  372.      MultText:ARRAY[0..7] OF String=(
  373. '       HMM... WHAT SHOULD I SAY ...                                          ',
  374. '     WHAT YOU DON''T SEE HERE: THE 8 SCROLLERS ON THE OTHER PAGE!            ',
  375. '   DIFFERENT SPEED AND ROTATING WASN''T POSSIBLE, NEXT TIME MAYBE?           ',
  376. ' THIS IS THE MIDDLE LINE --- AND THE MIDDLE OF THIS DENTRO ---               ',
  377. 'IT''S THE 26TH DECEMBER AND I FEEL BLUE ...                                  ',
  378. '  THEY SAY, IT''S MY NAME-DAY TODAY ...        AND A KISS FOR AVIVA          ',
  379. '    WELL, ASM''93 WAS REALLY FUN! THOUGH NOT GOOD ORGANIZED ...              ',
  380. '      LOOK OUT TO THE COMING AARDVARK PRODUCTIONS AVAILABLE SOON...          ');
  381. TYPE
  382.     ByteArray=ARRAY[0..65534] OF Byte;
  383.     LineType=ARRAY[0..3,0..79] OF Byte;
  384.     PalType=ARRAY[0..255,1..3] OF Byte;
  385.     OfsType=ARRAY[34..199,0..199] OF Byte;
  386. VAR
  387.    StartLogoSpr:Pointer;
  388.    FontCh:ARRAY[1..4,0..255] OF ^ByteArray;
  389.    L,Color,Gray,BeginPart:Byte;
  390.    I,J,K,Phase,Radius,StartR,StartG,StartB,OfsLines,Count,RasterLine,C,IncC,
  391.    Dir,LastOfs,Factor,Size,X,Y,XCountCurr,LastCos,CurrCos,Phase2:Integer;
  392.    SpiralTab:ARRAY[0..127] OF Integer;
  393.    BarTab:ARRAY[0..799] OF Byte;
  394.    BarStartTab:ARRAY[0..255] OF Integer;
  395.    SinVertTab:ARRAY[0..127] OF Integer;
  396.    Adr,Start,Shade:Word;
  397.    Cancel:Boolean;
  398.    BarLine:ARRAY[0..319] OF Byte;
  399.    Factors:ARRAY[0..63] OF Integer;
  400.    StartGap:ARRAY[0..63,0..5] OF Integer;
  401.    AardTextSpr:Pointer;
  402.    ScrollText1:String;
  403.    AardPicPal:PalType;
  404.    F:File;
  405.    TextF:Text;
  406.    Line:ARRAY[0..1023] OF Word;
  407.    Line2:ARRAY[0..1023] OF Integer;
  408.    OfsRel,OfsTable:ARRAY[0..1023] OF Integer;
  409.    SinTable:ARRAY[0..255] OF Byte;
  410.    ColorTab,GapTab:ARRAY[0..399] OF Byte;
  411.    StartMap,EndMap,R,G,B,PalSel:Byte;
  412.    XCount,YCount,SizeX,DirX,PhaseX:ARRAY[0..3] OF Integer;
  413.    LineData,LineData2:ARRAY[0..255] OF ^LineType;
  414.    DisplayStart:ARRAY[0..799] OF ShortInt;
  415.    Spr,BallLightSpr,EarthMapSpr:Pointer;
  416.    OfsTable2:^OfsType;
  417.    PlasmaPal:ARRAY[0..127] OF Byte;
  418.    Line640:ARRAY[0..639] OF Byte;
  419.    BallPal,Pal,Palette:PalType;
  420.    SpherePal:ARRAY[0..63] OF ^PalType;
  421.    LightTable:ARRAY[0..255] OF Byte;
  422.    SphereMap:ARRAY[0..15,0..15] OF Word;
  423.    EarthFrame:ARRAY[0..255] OF Byte;
  424.    ArcSinTable:ARRAY[-255..255] OF Real;
  425.    SinTab,CosTab:ARRAY[0..255] OF Integer;
  426.    CheckerSinTab,CheckerCosTab:ARRAY[0..255] OF Integer;
  427.    XLATTable:ARRAY[0..63] OF Byte;
  428.    MultOfsTable:ARRAY[0..31,0..31] OF Byte;
  429.    MultCount:ARRAY[0..7] OF Word;
  430.    SaveInt09,MODData:Pointer;
  431.    Key:ARRAY[0..127] OF Boolean;
  432.    Pressed,Tseng:Boolean;
  433.  
  434. PROCEDURE ANSIProc; EXTERNAL;
  435. {$L ANSICPFK.OBJ }
  436.  
  437. PROCEDURE NewInt09; INTERRUPT;
  438. VAR
  439.    KeyCode:Byte;
  440. BEGIN
  441.      ASM
  442.         in al,60h
  443.         mov keycode,al
  444.         in al,61h
  445.         mov ah,al
  446.         or al,80h
  447.         out 61h,al
  448.         mov al,ah
  449.         out 61h,al
  450.         mov al,20h
  451.         out 20h,al
  452.      END;
  453.      IF KeyCode<128 THEN
  454.         Key[KeyCode]:=TRUE
  455.      ELSE Key[KeyCode AND 127]:=FALSE;
  456. END;
  457.  
  458. PROCEDURE GetAdjMem(VAR P:Pointer; Size:Word);
  459. BEGIN
  460.      IF Word(Size+15)>Size THEN
  461.         Inc(Size,15)
  462.      ELSE Size:=65535;
  463.      GetMem(P,Size);
  464.      IF Ofs(P^)<>0 THEN
  465.         P:=Ptr(Seg(P^)+1,0);
  466. END;
  467.  
  468. PROCEDURE EndDemo;
  469. BEGIN
  470.      SetModeNr(3);
  471.      ANSIProc;
  472.      SetIntVec($09,SaveInt09);
  473.      Halt;
  474. END;
  475.  
  476. FUNCTION KeyCheck:Boolean;
  477. BEGIN
  478.      IF Key[1] THEN
  479.         EndDemo;
  480.      IF Pressed THEN
  481.         KeyCheck:=FALSE
  482.      ELSE
  483.      BEGIN
  484.           Pressed:=Key[28] OR Key[57];
  485.           KeyCheck:=Pressed;
  486.      END;
  487.      IF Pressed AND NOT Key[28] AND NOT Key[57] THEN
  488.         Pressed:=FALSE;
  489. END;
  490.  
  491. PROCEDURE LoadFontMCF(Font:Byte; FontData:Pointer);
  492. VAR
  493.    I,X,Y:Integer;
  494.    LongAdr:LongInt;
  495. BEGIN
  496.      FOR I:=0 TO 255 DO
  497.      BEGIN
  498.           FontCh[Font,I]:=FontData;
  499.           X:=Mem[Seg(FontData^):Ofs(FontData^)];
  500.           Y:=Mem[Seg(FontData^):Ofs(FontData^)+2];
  501.           LongAdr:=LongInt(Seg(FontData^)) SHL 4+Ofs(FontData^);
  502.           IF X*Y<>0 THEN
  503.              Inc(LongAdr,(X+1)*(Y+1));
  504.           Inc(LongAdr,4);
  505.           FontData:=Ptr(LongAdr SHR 4,LongAdr AND 15);
  506.      END;
  507. END;
  508.  
  509. PROCEDURE PutImageOn(X1,Y1:Integer; P:Pointer);
  510. VAR
  511.    Adr,I,XS,YS:Word;
  512. BEGIN
  513.      Adr:=Word(Y1)*80+X1 SHR 2;
  514.      FOR I:=0 TO 3 DO
  515.      BEGIN
  516.           SetReadMap(I);
  517.           SetWriteMap(1 SHL I);
  518.           ASM
  519.              push ds
  520.              lds si,p
  521.              lodsw
  522.              mov bx,ax
  523.              inc bx
  524.              lodsw
  525.              add si,i
  526.              mov dx,ax
  527.              inc dx
  528.              mov ax,0a000h
  529.              mov es,ax
  530.              mov di,adr
  531.              mov ah,64
  532.              cld
  533.              shr bx,2
  534.      @1:     mov cx,bx
  535.      @2:     lodsb
  536.              add si,3
  537.              cmp al,0
  538.              jz @3
  539.              or es:[di],ah
  540.      @3:     inc di
  541.              loop @2
  542.              add di,80
  543.              sub di,bx
  544.              dec dx
  545.              jnz @1
  546.              pop ds
  547.           END;
  548.      END;
  549. END;
  550.  
  551. PROCEDURE PutImageOff(X1,Y1:Integer; P:Pointer);
  552. VAR
  553.    Adr,I,XS,YS:Word;
  554. BEGIN
  555.      Adr:=Word(Y1)*80+X1 SHR 2;
  556.      FOR I:=0 TO 3 DO
  557.      BEGIN
  558.           SetReadMap(I);
  559.           SetWriteMap(1 SHL I);
  560.           ASM
  561.              push ds
  562.              lds si,p
  563.              lodsw
  564.              mov bx,ax
  565.              inc bx
  566.              lodsw
  567.              add si,i
  568.              mov dx,ax
  569.              inc dx
  570.              mov ax,0a000h
  571.              mov es,ax
  572.              mov di,adr
  573.              mov ah,191
  574.              cld
  575.              shr bx,2
  576.      @1:     mov cx,bx
  577.      @2:     lodsb
  578.              add si,3
  579.              cmp al,0
  580.              jz @3
  581.              and es:[di],ah
  582.      @3:     inc di
  583.              loop @2
  584.              add di,80
  585.              sub di,bx
  586.              dec dx
  587.              jnz @1
  588.              pop ds
  589.           END;
  590.      END;
  591. END;
  592.  
  593. PROCEDURE PutChar(Font:Byte; X,Y:Integer; Ch:Char; OnOff:Boolean);
  594. BEGIN
  595.      IF FontCh[Font,Ord(Ch)]<>NIL THEN
  596.         IF OnOff THEN
  597.            PutImageOn(X,Y,FontCh[Font,Ord(Ch)])
  598.         ELSE PutImageOff(X,Y,FontCh[Font,Ord(Ch)]);
  599. END;
  600.  
  601. PROCEDURE PutString(Font:Byte; X,Y:Integer; S:String; Distance:Integer; OnOff:Boolean);
  602. VAR
  603.    I:Integer;
  604. BEGIN
  605.      FOR I:=1 TO Length(S) DO
  606.      BEGIN
  607.           PutChar(Font,X,Y,S[I],OnOff);
  608.           Inc(X,Distance);
  609.      END;
  610. END;
  611.  
  612. PROCEDURE SetPixel4(X,Y:Integer; C:Byte);
  613. BEGIN
  614.      SetWriteMap(1 SHL (X AND 3));
  615.      Mem[$A000:Y*80+X SHR 2]:=C;
  616. END;
  617.  
  618. FUNCTION GetPixel4(X,Y:Integer):Byte;
  619. BEGIN
  620.      SetReadMap(X AND 3);
  621.      GetPixel4:=Mem[$A000:Y*80+X SHR 2];
  622. END;
  623.  
  624. PROCEDURE MakeStar;
  625. VAR
  626.    I,X,Y,XP,YP:Integer;
  627.    Shift,Value:Byte;
  628.    InRange:Boolean;
  629. BEGIN
  630.      REPEAT
  631.            X:=Integer(Random(500)-250);
  632.            Y:=Integer(Random(800)-400);
  633.      UNTIL (X<-160) OR (X>160) OR (Y<-100) OR (Y>100);
  634.      Shift:=Random(64);
  635.      X:=X SHL 4;
  636.      Y:=Y SHL 4;
  637.      FOR I:=63 DOWNTO 8 DO
  638.      BEGIN
  639.           XP:=Factors[I];
  640.           ASM
  641.              mov cl,0
  642.              mov ax,xp
  643.              mov bx,ax
  644.              imul x
  645.              add dx,160
  646.              or dx,dx
  647.              jl @1
  648.              cmp dx,319
  649.              jg @1
  650.              mov xp,dx
  651.              mov ax,bx
  652.              imul y
  653.              add dx,200
  654.              or dx,dx
  655.              jl @1
  656.              cmp dx,399
  657.              jg @1
  658.              mov yp,dx
  659.              mov cl,1
  660. @1:          mov inrange,cl
  661.           END;
  662.           IF InRange THEN
  663.           BEGIN
  664.                Value:=GetPixel4(XP,YP);
  665.                IF Value<127 THEN
  666.                   SetPixel4(XP,YP,Value AND 64+((I+Shift) AND 63));
  667.           END;
  668.      END;
  669. END;
  670.  
  671. PROCEDURE CalcFactors;
  672. VAR
  673.    I:Integer;
  674. BEGIN
  675.      FOR I:=8 TO 63 DO
  676.          Factors[I]:=65535 DIV (I+8);
  677. END;
  678.  
  679. PROCEDURE ActiveTransparent(Nr:Integer);
  680. VAR
  681.    Ph:Integer;
  682. BEGIN
  683.      Ph:=Phase-Nr;
  684.      IF Ph<64 THEN
  685.         SetColor(64+I,127-Ph,63,127-Ph)
  686.      ELSE SetColor(64+I,(Ph-64) SHR 1,63,(Ph-64) SHR 1);
  687. END;
  688.  
  689. PROCEDURE PassiveTransparent(Nr:Integer);
  690. VAR
  691.    Ph,I:Integer;
  692. BEGIN
  693.      Ph:=Phase-Nr;
  694.      IF Ph<64 THEN
  695.         FOR I:=0 TO 63 DO
  696.             SetColor(64+I,0,Ph,0)
  697.      ELSE
  698.      FOR I:=0 TO 63 DO
  699.          SetColor(64+I,0,(191-Ph) SHR 1,0);
  700. END;
  701.  
  702. FUNCTION Range(Nr:Integer):Boolean;
  703. BEGIN
  704.      Range:=(Phase>=Nr) AND (Phase<=Nr+191);
  705. END;
  706.  
  707. PROCEDURE DrawRectangle(Ph:Integer);
  708. BEGIN
  709.      DrawLineH4(1399-Ph,Ph-1080,(1400-Ph) SHL 1-2,128);
  710.      DrawLineH4(1399-Ph,Ph-1080,(1400-Ph) SHL 1-1,128);
  711.      DrawLineH4(1399-Ph,Ph-1080,(Ph-1200) SHL 1,128);
  712.      DrawLineH4(1399-Ph,Ph-1080,(Ph-1200) SHL 1+1,128);
  713.      DrawLineV4(1399-Ph,(1400-Ph) SHL 1,(Ph-1200) SHL 1-1,128);
  714.      DrawLineV4(Ph-1080,(1400-Ph) SHL 1,(Ph-1200) SHL 1-1,128);
  715. END;
  716.  
  717. PROCEDURE DrawFontBar(I,J:Integer);
  718. BEGIN
  719.      IF I<64 THEN
  720.      BEGIN
  721.           Count:=StartGap[I,J]-StartGap[I,J-1];
  722.           SetOffset(40);
  723.           FOR I:=0 TO 12 DO
  724.           BEGIN
  725.                Wait4Line;
  726.                Inc(RasterLine);
  727.           END;
  728.           SetOffset(0);
  729.           FOR I:=0 TO Count-1 DO
  730.           BEGIN
  731.                Wait4Line;
  732.                Inc(RasterLine);
  733.           END;
  734.      END
  735.      ELSE
  736.      BEGIN
  737.           SetOffset(40);
  738.           IF J=1 THEN
  739.           BEGIN
  740.                Wait4Line;
  741.                Inc(RasterLine);
  742.           END;
  743.           FOR I:=0 TO 10 DO
  744.           BEGIN
  745.                Wait4Line;
  746.                Inc(RasterLine);
  747.           END;
  748.           SetOffset(80);
  749.           Wait4Line;
  750.           Inc(RasterLine);
  751.      END;
  752. END;
  753.  
  754. PROCEDURE DrawPlasma;
  755. BEGIN
  756.      ASM
  757.         mov si,offset plasmapal
  758.         xor cx,cx
  759.         mov di,j
  760.         cld
  761. @1:     mov bx,di
  762.         add bx,cx
  763.         and bx,127
  764.         mov [si+bx],cl
  765.         mov bx,di
  766.         add bx,127
  767.         sub bx,cx
  768.         and bx,127
  769.         mov [si+bx],cl
  770.         inc cx
  771.         cmp cx,64
  772.         jnz @1
  773.      END;
  774.      WaitScreen;
  775.      ASM
  776.         xor cx,cx
  777.         mov dx,03c8h
  778.         mov al,128
  779.         out dx,al
  780.         mov si,offset plasmapal
  781.         cld
  782.         mov bx,start
  783.         shl bx,1
  784. @0:     and bx,1023
  785.         mov ah,byte ptr [bx+offset ofstable]
  786.         mov al,13h
  787.         mov dx,03d4h
  788.         out dx,ax
  789.         inc bx
  790.  
  791.         mov dx,03dah
  792. @1:     in al,dx
  793.         test al,1
  794.         jnz @1
  795.  
  796.         mov dx,03c9h
  797.         lodsb
  798.         out dx,al
  799.         mov al,0
  800.         out dx,al
  801.         out dx,al
  802.  
  803.         mov dx,03dah
  804. @2:     in al,dx
  805.         test al,1
  806.         jz @2
  807.  
  808.         inc cx
  809.         cmp cx,128
  810.         jnz @0
  811.      END;
  812.      ASM
  813.         mov si,start
  814.         shl si,1
  815.         add si,128
  816.         cld
  817. @0:     and si,1023
  818.         mov ah,byte ptr [si+offset ofstable]
  819.  
  820.         mov dx,03dah
  821. @1:     in al,dx
  822.         test al,1
  823.         jnz @1
  824.  
  825.         mov al,13h
  826.         mov dx,03d4h
  827.         out dx,ax
  828.         inc si
  829.  
  830.         mov dx,03dah
  831. @2:     in al,dx
  832.         test al,1
  833.         jz @2
  834.  
  835.         inc cx
  836.         cmp cx,399
  837.         jnz @0
  838.      END;
  839.      WaitRetrace;
  840. END;
  841.  
  842. PROCEDURE CalcBall;
  843. VAR
  844.    I,J,X,Y:Integer;
  845.    C:Byte;
  846. BEGIN
  847.      FOR J:=0 TO 15 DO
  848.          FOR I:=0 TO 15 DO
  849.          BEGIN
  850.               X:=I-16;
  851.               Y:=J-16;
  852.               IF Sqr(X)+Sqr(Y)<Sqr(16) THEN
  853.                  C:=16-Round(Sqrt(Sqr(X)+Sqr(Y)))
  854.               ELSE C:=0;
  855.               IF C>15 THEN
  856.                  C:=15;
  857.               BallPal[J SHL 4+I,1]:=C SHL 2;
  858.               BallPal[J SHL 4+I,2]:=C SHL 2;
  859.               BallPal[J SHL 4+I,3]:=C SHL 2;
  860.          END;
  861. END;
  862.  
  863. PROCEDURE CalcLines;
  864. VAR
  865.    I,J,K:Integer;
  866.    B,Map:Byte;
  867.    LineX:LineType;
  868. BEGIN
  869.      FOR J:=16 TO 254 DO
  870.          IF NOT Odd(J) THEN
  871.          BEGIN
  872.               New(LineData[J]);
  873.               ASM
  874.                  push ds
  875.                  pop es
  876.                  mov di,offset line640
  877.                  xor bx,bx
  878.                  mov dx,j
  879.                  shl dx,1
  880.                  mov cx,640
  881.                  cld
  882.     @1:          mov ax,bx
  883.                  shr ax,8
  884.                  and al,31
  885.                  cmp al,16
  886.                  jl @2
  887.                  neg al
  888.                  add al,31
  889.     @2:          stosb
  890.                  add bx,dx
  891.                  loop @1
  892.               END;
  893.               FOR K:=0 TO 3 DO
  894.               BEGIN
  895.                    Map:=1 SHL K;
  896.                    FOR I:=0 TO 79 DO
  897.                    BEGIN
  898.                         ASM
  899.                            mov si,i
  900.                            shl si,3
  901.                            add si,offset line640
  902.                            mov bl,map
  903.                            cld
  904. @1:                        mov bh,0
  905.                            lodsw
  906.                            and al,bl
  907.                            jnz @2
  908.                            or bh,128
  909. @2:                        and ah,bl
  910.                            jnz @3
  911.                            or bh,64
  912. @3:                        lodsw
  913.                            and al,bl
  914.                            jnz @4
  915.                            or bh,32
  916. @4:                        and ah,bl
  917.                            jnz @5
  918.                            or bh,16
  919. @5:                        lodsw
  920.                            and al,bl
  921.                            jnz @6
  922.                            or bh,8
  923. @6:                        and ah,bl
  924.                            jnz @7
  925.                            or bh,4
  926. @7:                        lodsw
  927.                            and al,bl
  928.                            jnz @8
  929.                            or bh,2
  930. @8:                        and ah,bl
  931.                            jnz @9
  932.                            or bh,1
  933. @9:                        mov b,bh
  934.                         END;
  935.                         LineX[K,I]:=B;
  936.                    END;
  937.               END;
  938.               LineData[J]^:=LineX;
  939.          END;
  940. END;
  941.  
  942. PROCEDURE PutLine(Nr:Integer);
  943. VAR
  944.    I,J:Integer;
  945. BEGIN
  946.      ASM
  947.         push ds
  948.         mov ax,0a000h
  949.         mov es,ax
  950.         mov bx,nr
  951.         shl bx,2
  952.         add bx,offset linedata
  953.         lds si,[bx]
  954.         cld
  955.         mov ax,0102h
  956. @1:     mov dx,03c4h
  957.         out dx,ax
  958.         xor di,di
  959.         mov cx,20
  960.         db 66h
  961.         rep movsw
  962.         shl ah,1
  963.         cmp ah,10h
  964.         jnz @1
  965.         pop ds
  966.      END;
  967. END;
  968.  
  969. PROCEDURE PutLine2(Nr:Integer);
  970. VAR
  971.    I,J:Integer;
  972. BEGIN
  973.      ASM
  974.         push ds
  975.         mov ax,0a000h
  976.         mov es,ax
  977.         mov bx,nr
  978.         shl bx,2
  979.         add bx,offset linedata2
  980.         lds si,[bx]
  981.         cld
  982.         mov ax,0102h
  983. @1:     mov dx,03c4h
  984.         out dx,ax
  985.         xor di,di
  986.         mov cx,20
  987.         db 66h
  988.         rep movsw
  989.         shl ah,1
  990.         cmp ah,10h
  991.         jnz @1
  992.         pop ds
  993.      END;
  994. END;
  995.  
  996. PROCEDURE DrawFrame;
  997. BEGIN
  998.      ASM
  999.         mov cx,400
  1000.         mov bx,y
  1001.  
  1002. @1:     mov dx,03c0h
  1003.         mov al,34h
  1004.         out dx,al
  1005.         mov al,bh
  1006.         and al,31
  1007.         cmp al,16
  1008.         jl @1a
  1009.         neg al
  1010.         add al,31
  1011. @1a:    out dx,al
  1012.         add bx,factor
  1013.  
  1014.         mov dx,03dah
  1015. @2:     in al,dx
  1016.         test al,1
  1017.         jnz @2
  1018. @3:     in al,dx
  1019.         test al,1
  1020.         jz @3
  1021.         loop @1
  1022.      END;
  1023. END;
  1024.  
  1025. PROCEDURE CalcLines2;
  1026. VAR
  1027.    I,J,K,L,X,XInc:Integer;
  1028.    Map:Byte;
  1029.    LineX:LineType;
  1030. BEGIN
  1031.      FOR J:=16 TO 127 DO
  1032.      BEGIN
  1033.           New(LineData2[J]);
  1034.           ASM
  1035.              push ds
  1036.              pop es
  1037.              mov di,offset line640
  1038.              xor bx,bx
  1039.              mov dx,j
  1040.              shl dx,1
  1041.              mov cx,640
  1042.              cld
  1043. @1:          mov ax,bx
  1044.              shr ax,8
  1045.              and al,15
  1046.              stosb
  1047.              add bx,dx
  1048.              loop @1
  1049.           END;
  1050.               FOR K:=0 TO 3 DO
  1051.               BEGIN
  1052.                    Map:=1 SHL K;
  1053.                    FOR I:=0 TO 79 DO
  1054.                    BEGIN
  1055.                         ASM
  1056.                            mov si,i
  1057.                            shl si,3
  1058.                            add si,offset line640
  1059.                            mov bl,map
  1060.                            cld
  1061. @1:                        mov bh,0
  1062.                            lodsw
  1063.                            and al,bl
  1064.                            jnz @2
  1065.                            or bh,128
  1066. @2:                        and ah,bl
  1067.                            jnz @3
  1068.                            or bh,64
  1069. @3:                        lodsw
  1070.                            and al,bl
  1071.                            jnz @4
  1072.                            or bh,32
  1073. @4:                        and ah,bl
  1074.                            jnz @5
  1075.                            or bh,16
  1076. @5:                        lodsw
  1077.                            and al,bl
  1078.                            jnz @6
  1079.                            or bh,8
  1080. @6:                        and ah,bl
  1081.                            jnz @7
  1082.                            or bh,4
  1083. @7:                        lodsw
  1084.                            and al,bl
  1085.                            jnz @8
  1086.                            or bh,2
  1087. @8:                        and ah,bl
  1088.                            jnz @9
  1089.                            or bh,1
  1090. @9:                        mov b,bh
  1091.                         END;
  1092.                         LineX[K,I]:=B;
  1093.                    END;
  1094.               END;
  1095.               LineData2[J]^:=LineX;
  1096.      END;
  1097. END;
  1098.  
  1099. PROCEDURE DrawFrame2;
  1100. BEGIN
  1101.      ASM
  1102.         mov cx,256
  1103.         mov bx,y
  1104.         mov dx,03c8h
  1105.         mov al,0
  1106.         out dx,al
  1107.         mov di,factor
  1108.         cld
  1109.         push ds
  1110.         mov si,phase
  1111.         shr si,1
  1112.         and si,63
  1113.         shl si,2
  1114.         lds si,dword ptr [si+offset spherepal]
  1115.         mov dx,03dah
  1116.  
  1117. @1:     in al,dx
  1118.         test al,1
  1119.         jz @1
  1120.  
  1121.         mov dx,03c9h
  1122.         outsb
  1123.         outsb
  1124.         outsb
  1125.  
  1126.         mov dx,03c0h
  1127.         mov al,34h
  1128.         out dx,al
  1129.         mov al,bh
  1130.         out dx,al
  1131.         add bx,di
  1132.  
  1133.         mov dx,03dah
  1134. @2:     in al,dx
  1135.         test al,1
  1136.         jnz @2
  1137.         loop @1
  1138.         pop ds
  1139.  
  1140.         mov cx,144
  1141.         mov di,03dah
  1142.         mov dx,03c0h
  1143.  
  1144. @4:     mov al,34h
  1145.         out dx,al
  1146.         mov al,bh
  1147.         and al,15
  1148.         out dx,al
  1149.         add bx,factor
  1150.  
  1151.         xchg dx,di
  1152. @5:     in al,dx
  1153.         test al,1
  1154.         jnz @5
  1155. @6:     in al,dx
  1156.         test al,1
  1157.         jz @6
  1158.         xchg dx,di
  1159.         loop @4
  1160.      END;
  1161. END;
  1162.  
  1163. FUNCTION ArcSin(X:Real):Real;
  1164. BEGIN
  1165.      ArcSin:=ArcTan(X/Sqrt(1-Sqr(X)))
  1166. END;
  1167.  
  1168. PROCEDURE CalcEarth;
  1169. VAR
  1170.    X,Y,X2,Y2,YSqr,YSqrt:Real;
  1171. BEGIN
  1172.      FOR J:=0 TO 15 DO
  1173.      BEGIN
  1174.           Y:=J-8;
  1175.           Y2:=ArcSin((255*Y)/8/256)/Pi*2;
  1176.           YSqrt:=Sqrt(1-Sqr(Y/8))*8;
  1177.           YSqr:=Sqr(Y);
  1178.           FOR I:=0 TO 15 DO
  1179.           BEGIN
  1180.                X:=I-8;
  1181.                IF Sqr(X)+YSqr<64 THEN
  1182.                BEGIN
  1183.                     X2:=ArcSin(255*X/YSqrt/256)/Pi*2;
  1184.                     SphereMap[J,I]:=(10+Round(Y2*15)) SHL 6+16+Round(X2*15)
  1185.                END
  1186.                ELSE SphereMap[J,I]:=0;
  1187.           END;
  1188.      END;
  1189. END;
  1190.  
  1191. PROCEDURE DrawEarth(Phase:Integer);
  1192. VAR
  1193.    I,J:Integer;
  1194. BEGIN
  1195.      FOR J:=0 TO 15 DO
  1196.          FOR I:=0 TO 15 DO
  1197.          BEGIN
  1198.               ASM
  1199.                  mov ax,ds
  1200.                  mov es,ax
  1201.                  mov di,offset earthframe
  1202.                  mov ax,j
  1203.                  shl ax,4
  1204.                  add di,ax
  1205.                  add di,i
  1206.                  mov si,j
  1207.                  shl si,4
  1208.                  add si,i
  1209.                  shl si,1
  1210.                  add si,offset spheremap
  1211.                  cld
  1212.                  lodsw
  1213.                  or ax,ax
  1214.                  jz @1
  1215.                  push ds
  1216.                  lds si,earthmapspr
  1217.                  mov si,phase
  1218.                  add si,ax
  1219.                  add si,4
  1220.                  movsb
  1221.                  pop ds
  1222.                  jmp @2
  1223. @1:              mov al,0
  1224.                  stosb
  1225. @2:
  1226.               END;
  1227.          END;
  1228. END;
  1229.  
  1230. PROCEDURE CalcOfsTable;
  1231. VAR
  1232.    I,J,CurrY,OldY,K:Integer;
  1233.    Fact:Word;
  1234. BEGIN
  1235.      New(OfsTable2);
  1236.      FOR J:=34 TO 199 DO
  1237.      BEGIN
  1238.           Fact:=Round(256/J*199);
  1239.           OldY:=199;
  1240.           FOR I:=199 DOWNTO 0 DO
  1241.               IF I>J THEN
  1242.                  OfsTable2^[J,I]:=0
  1243.               ELSE
  1244.               BEGIN
  1245.                    ASM
  1246.                       mov ax,i
  1247.                       mov bx,fact
  1248.                       mul bx
  1249.                       mov dh,dl
  1250.                       mov dl,ah
  1251.                       mov curry,dx
  1252.                    END;
  1253.                    OfsTable2^[J,I]:=40*(OldY-CurrY);
  1254.                    OldY:=CurrY;
  1255.               END;
  1256.      END;
  1257. END;
  1258.  
  1259. PROCEDURE ShowPicture;
  1260. BEGIN
  1261.      ASM
  1262.         mov bx,i
  1263.         sub bx,34
  1264.         mov ax,397
  1265.         mul bx
  1266.         mov bx,ax
  1267.  
  1268.         mov di,offset xlattable
  1269.         push ds
  1270.         pop es
  1271.         mov cx,64
  1272.         cld
  1273. @0:     mov al,64
  1274.         sub al,cl
  1275.         mov ah,0
  1276.         mul bx
  1277.         mov al,dl
  1278.         stosb
  1279.         loop @0
  1280.  
  1281.         mov dx,03c8h
  1282.         mov al,0
  1283.         out dx,al
  1284.         inc dx
  1285.         mov si,offset aardpicpal
  1286.         add si,329
  1287.         mov cx,110
  1288.         mov bx,offset xlattable
  1289.         std
  1290. @1:     lodsb
  1291.         xlat
  1292.         push ax
  1293.         lodsb
  1294.         xlat
  1295.         push ax
  1296.         lodsb
  1297.         xlat
  1298.         push ax
  1299.         loop @1
  1300.      END;
  1301.      WaitScreen;
  1302.      ASM
  1303.         mov ax,i
  1304.         mov di,ds
  1305.         lds si,ofstable2
  1306.         sub ax,34
  1307.         mov bx,200
  1308.         mul bx
  1309.         add si,ax
  1310.         add si,199
  1311.         mov cx,200
  1312.         std
  1313.  
  1314.         mov dx,3dah
  1315. @1:     in al,dx
  1316.         test al,1
  1317.         jnz @1
  1318.  
  1319. @2:     lodsb
  1320.         mov ah,al
  1321.         mov al,13h
  1322.         mov dx,03d4h
  1323.         out dx,ax
  1324.  
  1325.         cmp cx,90
  1326.         jle @3
  1327.         mov dx,03c9h
  1328.         pop ax
  1329.         out dx,al
  1330.         pop ax
  1331.         out dx,al
  1332.         pop ax
  1333.         out dx,al
  1334.  
  1335. @3:     mov dx,3dah
  1336. @4:     in al,dx
  1337.         test al,1
  1338.         jz @4
  1339.  
  1340.         loop @1
  1341.      END;
  1342.      ASM
  1343.         inc si
  1344.         cld
  1345.         mov cx,200
  1346.  
  1347. @1:     mov dx,3dah
  1348.         in al,dx
  1349.         test al,1
  1350.         jnz @1
  1351.  
  1352. @2:     lodsb
  1353.         mov ah,al
  1354.         mov al,13h
  1355.         mov dx,3d4h
  1356.         out dx,ax
  1357.  
  1358.         mov dx,3dah
  1359. @3:     in al,dx
  1360.         test al,1
  1361.         jz @3
  1362.  
  1363.         loop @1
  1364.         mov ds,di
  1365.      END;
  1366.      WaitRetrace;
  1367. END;
  1368.  
  1369. PROCEDURE CalcMultOfsTable;
  1370. VAR
  1371.    I,J,CurrY,OldY:Integer;
  1372. BEGIN
  1373.      FOR J:=6 TO 31 DO
  1374.      BEGIN
  1375.           OldY:=31;
  1376.           FOR I:=31 DOWNTO 0 DO
  1377.               IF I>J THEN
  1378.                  MultOfsTable[J,I]:=0
  1379.               ELSE
  1380.               BEGIN
  1381.                    CurrY:=Round(I/J*31);
  1382.                    MultOfsTable[J,I]:=40*(OldY-CurrY);
  1383.                    OldY:=CurrY;
  1384.               END;
  1385.      END;
  1386. END;
  1387.  
  1388. PROCEDURE PutPartChar(X,Y:Integer; Nr:Integer; TextCh:Char);
  1389. BEGIN
  1390.      ASM
  1391.         push ds
  1392.         mov ax,0a000h
  1393.         mov es,ax
  1394.         mov ax,y
  1395.         shl ax,4
  1396.         mov di,ax
  1397.         shl ax,2
  1398.         add di,ax
  1399.         mov ax,x
  1400.         add ax,start
  1401.         mov cl,al
  1402.         and cl,3
  1403.         shr ax,2
  1404.         add di,ax
  1405.         mov ax,0102h
  1406.         shl ah,cl
  1407.         mov dx,03c4h
  1408.         out dx,ax
  1409.         mov bl,textch
  1410.         mov bh,0
  1411.         shl bx,2
  1412.         add bx,offset fontch+3072
  1413.         lds si,[bx]
  1414.         add si,4
  1415.         add si,nr
  1416.         mov cx,31
  1417.         cld
  1418. @1:     lodsb
  1419.         stosb
  1420.         add di,79
  1421.         stosb
  1422.         add di,79
  1423.         add si,31
  1424.         loop @1
  1425.         pop ds
  1426.      END;
  1427. END;
  1428.  
  1429. PROCEDURE SetPal(VAR Palette; Count:Integer);
  1430. BEGIN
  1431.      ASM
  1432.         push ds
  1433.         mov dx,03c8h
  1434.         mov al,0
  1435.         out dx,al
  1436.         out dx,al
  1437.         out dx,al
  1438.         lds si,palette
  1439.         mov cx,count
  1440.         mov bx,cx
  1441.         shl cx,1
  1442.         add cx,bx
  1443.         inc dx
  1444.         cld
  1445.         rep outsb
  1446.         pop ds
  1447.      END;
  1448. END;
  1449.  
  1450. PROCEDURE SetReg(Reg:Word; Index,Value:Byte);
  1451. VAR
  1452.    B:Byte;
  1453. BEGIN
  1454.      CASE Reg OF
  1455.           $3C0:BEGIN
  1456.                     B:=Port[$3DA];
  1457.                     Port[$3C0]:=Index OR $20;
  1458.                     Port[$3C0]:=Value;
  1459.                END;
  1460.           $3C2,$3C3:Port[Reg]:=Value;
  1461.           ELSE
  1462.           BEGIN
  1463.                Port[Reg]:=Index;
  1464.                Port[Reg+1]:=Value;
  1465.           END;
  1466.      END;
  1467. END;
  1468.  
  1469. PROCEDURE SetModeReg(Reg:String; VAR P);
  1470. TYPE
  1471.     RegRec=RECORD
  1472.                  Reg:Word;
  1473.                  Index:Byte;
  1474.                  Value:Byte;
  1475.            END;
  1476. VAR
  1477.    RegFile:File OF RegRec;
  1478.    RegSet:ARRAY[0..36] OF RegRec ABSOLUTE P;
  1479. BEGIN
  1480.      Port[$3D4]:=$11;
  1481.      Port[$3D5]:=Port[$3D5] AND $7F;
  1482.      FOR I:=0 TO 35 DO
  1483.          WITH RegSet[I] DO
  1484.               SetReg(Reg,Index,Value);
  1485.      ClearScreen;
  1486. END;
  1487.  
  1488. PROCEDURE InitPartI;
  1489. BEGIN
  1490.      LoadFontMCF(2,@BluGreen);
  1491.      FOR I:=0 TO 63 DO
  1492.          FOR J:=0 TO 5 DO
  1493.              StartGap[I,J]:=Round(16*J*Sin(I/64*Pi));
  1494.      Move(@AardCpFkPal^,AardPicPal,768);
  1495.      StartLogoSpr:=@StartLogSpr;
  1496.      CalcFactors;
  1497.      LoadFontMCF(1,@WildFont);
  1498. END;
  1499.  
  1500. PROCEDURE InitPartII;
  1501. BEGIN
  1502.      FOR I:=0 TO 127 DO
  1503.          SpiralTab[I]:=Round(255*Sin(I/64*Pi));
  1504.      FOR I:=0 TO 255 DO
  1505.          BarStartTab[I]:=127+Round(127*Sin(I/128*Pi));
  1506.      FOR I:=0 TO 63 DO
  1507.      BEGIN
  1508.           BarTab[400+I]:=I;
  1509.           BarTab[527-I]:=I;
  1510.      END;
  1511.      FOR I:=0 TO 399 DO
  1512.          BarTab[I]:=0;
  1513.      FOR I:=528 TO 799 DO
  1514.          BarTab[I]:=0;
  1515. END;
  1516.  
  1517. PROCEDURE InitPartIV;
  1518. BEGIN
  1519.      FOR I:=0 TO 127 DO
  1520.          SinVertTab[I]:=Round(144*Sin(I*Pi/64));
  1521. END;
  1522.  
  1523. PROCEDURE InitPartV;
  1524. BEGIN
  1525.      FOR I:=0 TO 511 DO
  1526.      BEGIN
  1527.           Line[I]:=152+Round(70*Sin(I*Pi/256));
  1528.           Line[512+I]:=Line[I];
  1529.      END;
  1530.      FOR I:=0 TO 127 DO
  1531.      BEGIN
  1532.           Line2[I]:=Round(40*Sin(I*Pi/64));
  1533.           FOR J:=1 TO 7 DO
  1534.               Line2[J SHL 7+I]:=Line2[I];
  1535.      END;
  1536.      FOR I:=0 TO 1023 DO
  1537.          Inc(Line[I],Line2[I]);
  1538. END;
  1539.  
  1540. PROCEDURE InitPartVI;
  1541. BEGIN
  1542.      CalcMultOfsTable;
  1543.      LoadFontMCF(4,@Hollow);
  1544.      FOR K:=0 TO 7 DO
  1545.          MultCount[K]:=0;
  1546. END;
  1547.  
  1548. PROCEDURE InitPartVII;
  1549. BEGIN
  1550.      FOR I:=0 TO 255 DO
  1551.          SinTable[I]:=32+Round(31*Sin(I/128*Pi));
  1552.      FOR I:=0 TO 127 DO
  1553.      BEGIN
  1554.           OfsRel[I]:=Round(8*Sin(I/64*Pi));
  1555.           FOR J:=1 TO 7 DO
  1556.               OfsRel[J SHL 7+I]:=OfsRel[I];
  1557.      END;
  1558.      LastOfs:=OfsRel[0];
  1559.      OfsTable[0]:=80;
  1560.      FOR I:=1 TO 1023 DO
  1561.      BEGIN
  1562.           IF OfsRel[I]<>LastOfs THEN
  1563.              OfsTable[I]:=80+LastOfs-OfsRel[I]
  1564.           ELSE OfsTable[I]:=80;
  1565.           LastOfs:=OfsRel[I];
  1566.      END;
  1567. END;
  1568.  
  1569. PROCEDURE InitPartVIII;
  1570. BEGIN
  1571.      FOR I:=0 TO 127 DO
  1572.      BEGIN
  1573.           FOR J:=0 TO 1 DO
  1574.           BEGIN
  1575.                SinTab[J SHL 7+I]:=Round(64*Sin(I/64*Pi));
  1576.                CosTab[J SHL 7+I]:=Round(200*Cos(I/64*Pi));
  1577.           END;
  1578.      END;
  1579.      CalcBall;
  1580.      CalcLines;
  1581. END;
  1582.  
  1583. PROCEDURE InitPartIX;
  1584. VAR
  1585.    P:Pointer;
  1586. BEGIN
  1587.      CalcEarth;
  1588.      Move(@EarthMapData^,Palette,768);
  1589.      GetAdjMem(EarthMapSpr,1344);
  1590.      P:=@EarthMapData;
  1591.      P:=Ptr(Seg(P^),Ofs(P^)+768);
  1592.      Move(P^,EarthMapSpr^,1344);
  1593.      P:=@BalLightSpr;
  1594.      P:=Ptr(Seg(P^),Ofs(P^)+4);
  1595.      Move(P^,EarthMapSpr^,1344);
  1596. {
  1597.      Move(Ptr(Seg(@EarthMapData^),Ofs(@EarthMapData^)+768)^,EarthMapSpr^,1344);
  1598.      Move(Ptr(Seg(@BalLightSpr^),Ofs(@BalLightSpr^)+4)^,LightTable,256);
  1599. }
  1600.      FOR I:=0 TO 63 DO
  1601.      BEGIN
  1602.           DrawEarth(I);
  1603.           GetAdjMem(Pointer(SpherePal[I]),768);
  1604.           FOR J:=0 TO 255 DO
  1605.           BEGIN
  1606.                SpherePal[I]^[J,1]:=(Palette[EarthFrame[J],1]*LightTable[J]) SHR 8;
  1607.                SpherePal[I]^[J,2]:=(Palette[EarthFrame[J],2]*LightTable[J]) SHR 8;
  1608.                SpherePal[I]^[J,3]:=(Palette[EarthFrame[J],3]*LightTable[J]) SHR 8;
  1609.           END;
  1610.      END;
  1611.      CalcLines2;
  1612. END;
  1613.  
  1614. PROCEDURE InitPartX;
  1615. BEGIN
  1616.      FOR I:=0 TO 127 DO
  1617.      BEGIN
  1618.           FOR J:=0 TO 1 DO
  1619.           BEGIN
  1620.                CheckerSinTab[J SHL 7+I]:=Round(128*Sin(I/64*Pi));
  1621.                CheckerCosTab[J SHL 7+I]:=Round(128*Cos(I/64*Pi));
  1622.           END;
  1623.      END;
  1624.      FOR I:=0 TO 2 DO
  1625.      BEGIN
  1626.           SizeX[I]:=1;
  1627.           DirX[I]:=1;
  1628.           IF SizeX[I]>127 THEN
  1629.           BEGIN
  1630.                SizeX[I]:=255-SizeX[I];
  1631.                DirX[I]:=-1;
  1632.           END;
  1633.           PhaseX[I]:=32*I;
  1634.      END;
  1635. END;
  1636.  
  1637. PROCEDURE InitPartXI;
  1638. BEGIN
  1639.      CalcOfsTable;
  1640.      FOR I:=0 TO 99 DO
  1641.      BEGIN
  1642.           DisplayStart[I]:=Round(20*Sin(I/50*Pi));
  1643.           FOR J:=1 TO 7 DO
  1644.               DisplayStart[J*100+I]:=DisplayStart[I];
  1645.      END;
  1646. END;
  1647.  
  1648. PROCEDURE InitPartXIII;
  1649. BEGIN
  1650.      LoadFontMCF(3,@Clean16);
  1651.      LastCos:=Round(200*Sqrt(Cos(Pi/2)));
  1652.      FOR I:=139 DOWNTO 0 DO
  1653.      BEGIN
  1654.           CurrCos:=Round(140*Sqrt(Cos(I/280*Pi)));
  1655.           GapTab[139-I]:=CurrCos-LastCos+1;
  1656.           IF GapTab[139-I]>7 THEN
  1657.              GapTab[139-I]:=224
  1658.           ELSE GapTab[139-I]:=GapTab[139-I] SHL 5;
  1659.           GapTab[260+I]:=GapTab[139-I];
  1660.           LastCos:=CurrCos;
  1661.      END;
  1662.      FOR I:=0 TO 199 DO
  1663.      BEGIN
  1664.           ColorTab[I]:=Round(63*Sin((I+56)/512*Pi));
  1665.           ColorTab[399-I]:=ColorTab[I];
  1666.      END;
  1667.      FOR I:=140 TO 259 DO
  1668.          GapTab[I]:=32;
  1669. END;
  1670.  
  1671. { Part I - Palette Starfield + Transparent Text }
  1672.  
  1673. PROCEDURE PartI;
  1674. BEGIN
  1675.      Init13X;
  1676.      SetLineRepeat(0);
  1677.      SwitchOff;
  1678.      FOR I:=0 TO 255 DO
  1679.          SetColor(I,0,0,0);
  1680.      SetPal(@StartLogPal^,256);
  1681.      PutImage4(70,140,StartLogoSpr^);
  1682.      SwitchOn;
  1683.      Phase:=0;
  1684.      I:=63;
  1685.      Gray:=0;
  1686.      REPEAT
  1687.            CLI;
  1688.            IF Phase<63 THEN
  1689.               Inc(Gray);
  1690.            IF Phase>=1330 THEN
  1691.            BEGIN
  1692.                 DrawRectangle(Phase);
  1693.                 IF Phase>=1336 THEN
  1694.                    SetColor(128,Phase-1336,Phase-1336,Phase-1336)
  1695.                 ELSE SetColor(128,0,0,0);
  1696.            END;
  1697.            IF Phase<1250 THEN
  1698.            BEGIN
  1699.                 MakeStar;
  1700.                 MakeStar;
  1701.                 MakeStar;
  1702.                 MakeStar;
  1703.            END;
  1704.            VerticalRetrace;
  1705.            SetColor(I,0,0,0);
  1706.            IF I=1 THEN
  1707.               SetColor(63,Gray,Gray,Gray)
  1708.            ELSE SetColor(I-1,Gray,Gray,Gray);
  1709.            IF Phase=100 THEN
  1710.               PutString(1,72,40,'',16,TRUE)
  1711.            ELSE
  1712.            IF Phase=300 THEN
  1713.            BEGIN
  1714.                 PutString(1,72,40,'GREETINGS FOLKS',16,FALSE);
  1715.                 PutString(1,32,300,'THIS IS OUR NEW',16,TRUE);
  1716.            END
  1717.            ELSE
  1718.            IF Phase=500 THEN
  1719.            BEGIN
  1720.                 PutString(1,32,300,'THIS IS OUR NEW',16,FALSE);
  1721.                 PutString(1,12,80,'DENTRO CALLED',16,TRUE);
  1722.            END
  1723.            ELSE
  1724.            IF Phase=700 THEN
  1725.            BEGIN
  1726.                 PutString(1,12,80,'DENTRO CALLED',16,FALSE);
  1727.                 PutString(1,72,280,'COPPER FAKED',16,TRUE);
  1728.            END
  1729.            ELSE
  1730.            IF Phase=900 THEN
  1731.            BEGIN
  1732.                 PutString(1,72,280,'COPPER FAKED',16,FALSE);
  1733.                 PutString(1,20,40,'STARRING THE FAKER',16,TRUE);
  1734.            END
  1735.            ELSE
  1736.            IF Phase=1100 THEN
  1737.            BEGIN
  1738.                 PutString(1,20,40,'STARRING THE FAKER',16,FALSE);
  1739.                 PutString(1,0,320,'AND 4999 OTHER STARS',16,TRUE);
  1740.            END;
  1741.            IF Range(100) THEN
  1742.               PassiveTransparent(100)
  1743.            ELSE
  1744.            IF Range(300) THEN
  1745.               PassiveTransparent(300)
  1746.            ELSE
  1747.            IF Range(500) THEN
  1748.               PassiveTransparent(500)
  1749.            ELSE
  1750.            IF Range(700) THEN
  1751.               PassiveTransparent(700)
  1752.            ELSE
  1753.            IF Range(900) THEN
  1754.               PassiveTransparent(900)
  1755.            ELSE
  1756.            IF Range(1100) THEN
  1757.               PassiveTransparent(1100)
  1758.            ELSE
  1759.            BEGIN
  1760.                 FOR J:=0 TO 63 DO
  1761.                     SetColor(64+I,0,0,0);
  1762.            END;
  1763.            IF I=1 THEN
  1764.               I:=63
  1765.            ELSE Dec(I);
  1766.            IF Range(100) THEN
  1767.               ActiveTransparent(100)
  1768.            ELSE
  1769.            IF Range(300) THEN
  1770.               ActiveTransparent(300)
  1771.            ELSE
  1772.            IF Range(500) THEN
  1773.               ActiveTransparent(500)
  1774.            ELSE
  1775.            IF Range(700) THEN
  1776.               ActiveTransparent(700)
  1777.            ELSE
  1778.            IF Range(900) THEN
  1779.               ActiveTransparent(900)
  1780.            ELSE
  1781.            IF Range(1100) THEN
  1782.               ActiveTransparent(1100)
  1783.            ELSE SetColor(64+I,Gray,Gray,Gray);
  1784.            Inc(Phase);
  1785.            IF NOT Cancel AND KeyCheck THEN
  1786.            BEGIN
  1787.                 Cancel:=TRUE;
  1788.                 Phase:=1330;
  1789.            END;
  1790.            STI;
  1791.      UNTIL (Phase=1400) OR KeyCheck;
  1792. END;
  1793.  
  1794. { Part II - Rotating Logo + Overlaying Copper Bars }
  1795.  
  1796. PROCEDURE PartII;
  1797. BEGIN
  1798.      SetColor(0,63,63,63);
  1799.      SetWriteMap(15);
  1800.      ASM
  1801.         mov ax,0a000h
  1802.         mov es,ax
  1803.         xor di,di
  1804.         mov cx,2800
  1805.         db 66h
  1806.         xor ax,ax
  1807.         cld
  1808.         db 66h
  1809.         rep stosw
  1810.         mov di,20800
  1811.         mov cx,2800
  1812.         db 66h
  1813.         rep stosw
  1814.      END;
  1815.      FOR I:=140 TO 259 DO
  1816.      BEGIN
  1817.           DrawLineH4(0,69,I,0);
  1818.           DrawLineH4(250,319,I,0);
  1819.      END;
  1820.      FOR I:=0 TO 63 DO
  1821.      BEGIN
  1822.           VerticalRetrace;
  1823.           SetColor(0,63-I,63-I,63-I);
  1824.      END;
  1825.      Phase:=0;
  1826.      Radius:=0;
  1827.      REPEAT
  1828.            CLI;
  1829.            IF Phase<1312 THEN
  1830.            BEGIN
  1831.                 ASM
  1832.                    mov si,phase
  1833.                    add si,32
  1834.                    and si,127
  1835.                    shl si,1
  1836.                    mov ax,word ptr [si+offset spiraltab]
  1837.                    imul radius
  1838.                    mov al,ah
  1839.                    mov ah,dl
  1840.                    add ax,128*320
  1841.                    mov start,ax
  1842.  
  1843.                    mov si,phase
  1844.                    and si,127
  1845.                    shl si,1
  1846.                    mov ax,word ptr [si+offset spiraltab]
  1847.                    shl ax,1
  1848.                    imul radius
  1849.                    mov al,ah
  1850.                    mov ah,dl
  1851.                    add ax,128
  1852.                    mov ofslines,ax
  1853.                 END;
  1854.                 SetHorizOfs(Start AND 3);
  1855.                 SetStart(Start SHR 2);
  1856.            END
  1857.            ELSE
  1858.            IF Phase=1312 THEN
  1859.            BEGIN
  1860.                 OfsLines:=0;
  1861.                 SetStart(0);
  1862.                 SetHorizOfs(0);
  1863.                 Split(124);
  1864.            END;
  1865.            IF Phase<61+9 THEN
  1866.               StartR:=255+61+9-Phase
  1867.            ELSE
  1868.            IF Phase<957 THEN
  1869.               StartR:=BarStartTab[Phase AND 255]
  1870.            ELSE
  1871.            IF Phase>1297 THEN
  1872.               StartR:=1297-Phase
  1873.            ELSE StartR:=0;
  1874.            IF Phase<103 THEN
  1875.               StartG:=383
  1876.            ELSE
  1877.            IF Phase<231+9 THEN
  1878.               StartG:=255+231+9-Phase
  1879.            ELSE
  1880.            IF Phase<1127 THEN
  1881.               StartG:=BarStartTab[(Phase+86) AND 255]
  1882.            ELSE
  1883.            IF Phase>1297 THEN
  1884.               StartG:=1297-Phase
  1885.            ELSE StartG:=0;
  1886.            IF Phase<273 THEN
  1887.               StartB:=383
  1888.            ELSE
  1889.            IF Phase<401+9 THEN
  1890.               StartB:=255+401+9-Phase
  1891.            ELSE
  1892.            IF Phase<1042 THEN
  1893.               StartB:=BarStartTab[(Phase+172) AND 255]
  1894.            ELSE
  1895.            IF Phase>1297 THEN
  1896.               StartB:=1297-Phase
  1897.            ELSE StartB:=0;
  1898.            IF Phase>1297 THEN
  1899.            BEGIN
  1900.                 StartR:=0;
  1901.                 StartG:=0;
  1902.                 StartB:=0;
  1903.            END;
  1904.            SetColor(0,0,0,0);
  1905.            SetOffset(0);
  1906.            VerticalRetrace;
  1907.            FOR I:=0 TO 7 DO
  1908.            BEGIN
  1909.                 IF I=OfsLines THEN
  1910.                    SetOffset(40);
  1911.                 Wait4Line;
  1912.            END;
  1913.            FOR I:=0 TO 383 DO
  1914.            BEGIN
  1915.                 IF I+8=OfsLines THEN
  1916.                    SetOffset(40);
  1917.                 ASM
  1918.                    mov dx,3c8h
  1919.                    mov al,0
  1920.                    out dx,al
  1921.                    inc dx
  1922.                    mov si,144
  1923.                    add si,startr
  1924.                    and si,511
  1925.                    add si,offset bartab
  1926.                    outsb
  1927.                    mov si,144
  1928.                    add si,startg
  1929.                    and si,511
  1930.                    add si,offset bartab
  1931.                    outsb
  1932.                    mov si,144
  1933.                    add si,startb
  1934.                    and si,511
  1935.                    add si,offset bartab
  1936.                    outsb
  1937.  
  1938.                    mov dx,3dah
  1939. @1:                in al,dx
  1940.                    test al,1
  1941.                    jnz @1
  1942.                    mov dx,3dah
  1943. @2:                in al,dx
  1944.                    test al,1
  1945.                    jz @2
  1946.                 END;
  1947.                 Inc(StartR);
  1948.                 Inc(StartG);
  1949.                 Inc(StartB);
  1950.            END;
  1951.            SetColor(0,0,0,0);
  1952.            FOR I:=0 TO 7 DO
  1953.            BEGIN
  1954.                 IF I=OfsLines THEN
  1955.                    SetOffset(40);
  1956.                 Wait4Line;
  1957.            END;
  1958.            IF (Phase<256) AND (Phase AND 3=0) THEN
  1959.               Inc(Radius);
  1960.            Inc(Phase);
  1961.            STI;
  1962.      UNTIL (Phase=1425) OR KeyCheck;
  1963. END;
  1964.  
  1965. { Phase III - Bouncing Scroller }
  1966.  
  1967. PROCEDURE PartIII;
  1968. BEGIN
  1969.      Port[$3D4]:=$11;
  1970.      Port[$3D5]:=Port[$3D5] AND $7F;
  1971.      Port[$3D4]:=1;
  1972.      Port[$3D5]:=Port[$3D5]-1;
  1973.      SetPal(@BluGreenPal^,64);
  1974.      Port[$3C0]:=$10;
  1975.      Port[$3C0]:=Port[$3C1] OR $20;
  1976.      SetLineRepeat(0);
  1977.      Split(201);
  1978.      ScrollText1:='THIS DENTRO IS THE FORMAL ANNOUNCATION OF OUR COMING LARGE DEMO ...             ';
  1979.      Phase:=0;
  1980.      SetWriteMap(15);
  1981.      REPEAT
  1982.            CLI;
  1983.            SetStart($8000+Phase SHR 2);
  1984.            SetHorizOfs(Phase AND 3);
  1985.            SetWriteMap(1 SHL (Phase AND 3));
  1986.            FOR J:=0 TO 4 DO
  1987.            BEGIN
  1988.                 FOR I:=0 TO 11 DO
  1989.                     Mem[$A800:(1+J*13+I)*80+Phase SHR 2+79]:=FontCh[2,Ord(ScrollText1[1+Phase SHR 5])]^
  1990.                        [4+(J*6+I SHR 1) SHL 5+Phase AND 31];
  1991.                 Mem[$A800:(J*13)*80+Phase SHR 2+79]:=0;
  1992.            END;
  1993.            SetOffset(0);
  1994.            RasterLine:=0;
  1995.            SetColor(0,0,0,0);
  1996.            VerticalRetrace;
  1997.            IF Phase AND 127<64 THEN
  1998.               Count:=81-StartGap[Phase AND 127,5]
  1999.            ELSE Count:=81+StartGap[Phase AND 63,3];
  2000.            FOR I:=0 TO Count-1 DO
  2001.            BEGIN
  2002.                 Wait4Line;
  2003.                 Inc(RasterLine);
  2004.            END;
  2005.            FOR I:=1 TO 5 DO
  2006.                DrawFontBar(Phase AND 127,I);
  2007.            FOR I:=RasterLine TO 199 DO
  2008.                Wait4Line;
  2009.            SetOffset(120);
  2010.            StartR:=337;
  2011.            FOR I:=0 TO 189 DO
  2012.            BEGIN
  2013.                 IF I=14 THEN
  2014.                    SetOffset(80);
  2015.                 IF I=70 THEN
  2016.                    SetOffset(40);
  2017.                 SetColor(0,BarTab[StartR],BarTab[StartR],BarTab[StartR]);
  2018.                 Wait4Line;
  2019.                 Inc(StartR);
  2020.            END;
  2021.            Inc(Phase);
  2022.            STI;
  2023.      UNTIL (Phase=2048+512) OR KeyCheck;
  2024.      SetWriteMap(15);
  2025.      ASM
  2026.         mov ax,0a800h
  2027.         mov es,ax
  2028.         xor di,di
  2029.         mov cx,8192
  2030.         db 66h
  2031.         xor ax,ax
  2032.         cld
  2033.         db 66h
  2034.         rep stosw
  2035.      END;
  2036.      Port[$3D4]:=1;
  2037.      Port[$3D5]:=Port[$3D5]+1;
  2038. END;
  2039.  
  2040. { Part IV - Vertical bars as well as horizontal ones }
  2041.  
  2042. PROCEDURE PartIV;
  2043. BEGIN
  2044.      SetPal(@StandardXPal^,128);
  2045.      Split(511);
  2046.      SetHorizOfs(0);
  2047.      Phase:=0;
  2048.      Start:=21000;
  2049.      SetStart(Start);
  2050.      REPEAT
  2051.            CLI;
  2052.            ASM
  2053.               mov di,offset barline
  2054.               mov ax,ds
  2055.               mov es,ax
  2056.               mov cx,160
  2057.               xor ax,ax
  2058.               rep stosw
  2059.            END;
  2060.            FOR J:=2 TO 8 DO
  2061.                IF (Phase>23+(8-J)*72) AND (Phase<23+1512-256+J*72) THEN
  2062.                BEGIN
  2063.                     K:=144+SinVertTab[(Phase+J SHL 3) AND 127];
  2064.                     ASM
  2065.                        mov ax,ds
  2066.                        mov es,ax
  2067.                        mov di,offset barline
  2068.                        add di,k
  2069.                        mov cx,8
  2070.                        add cx,j
  2071.                        mov ax,j
  2072.                        shl ax,4
  2073.                        dec al
  2074. @1:                    stosb
  2075.                        dec ax
  2076.                        loop @1
  2077.                        mov cx,8
  2078.                        add cx,j
  2079.                        inc ax
  2080. @2:                    stosb
  2081.                        inc ax
  2082.                        loop @2
  2083.                     END;
  2084.                END;
  2085.            IF Phase<512+32 THEN
  2086.               K:=0
  2087.            ELSE
  2088.            FOR I:=0 TO 3 DO
  2089.            BEGIN
  2090.                 SetWriteMap(1 SHL I);
  2091.                 ASM
  2092.                    mov si,offset barline
  2093.                    mov ax,0a000h
  2094.                    mov es,ax
  2095.                    mov di,start
  2096.                    add si,i
  2097.                    mov cx,40
  2098.                    cld
  2099. @1:                mov al,[si]
  2100.                    mov ah,[si+4]
  2101.                    add si,8
  2102.                    stosw
  2103.                    loop @1
  2104.                 END;
  2105.            END;
  2106.            IF (Phase>=1120) AND (Phase<1120+112) THEN
  2107.               K:=Phase-832
  2108.            ELSE
  2109.            IF (Phase>=1120+112) AND (Phase<1120+144) THEN
  2110.               K:=400
  2111.            ELSE
  2112.            IF (Phase>=1120+144) AND (Phase<1120+256) THEN
  2113.               K:=1664-Phase
  2114.            ELSE
  2115.            IF Phase=1120+256 THEN
  2116.            BEGIN
  2117.                 SetWriteMap(15);
  2118.                 FillChar(Ptr($A000,21000)^,81,0);
  2119.                 Start:=11040-16*80;
  2120.                 SetStart(Start);
  2121.            END;
  2122.            SetOffset(0);
  2123.            WaitScreen;
  2124.            ASM
  2125.               mov si,offset barline
  2126.            END;
  2127.            FOR I:=0 TO 319 DO
  2128.            BEGIN
  2129.                 IF I=K THEN
  2130.                    SetOffset(40);
  2131.                 ASM
  2132. @1:                mov dx,$3da
  2133.                    in al,dx
  2134.                    test al,1
  2135.                    jnz @1
  2136.  
  2137.                    lodsb
  2138.                    cmp al,0
  2139.                    jnz @1a
  2140.                    mov dx,$3c8
  2141.                    out dx,al
  2142.                    inc dx
  2143.                    out dx,al
  2144.                    out dx,al
  2145.                    out dx,al
  2146.                    jmp @1b
  2147. @1a:               mov dx,$3c7
  2148.                    out dx,al
  2149.                    inc dx
  2150.                    inc dx
  2151.                    in al,dx
  2152.                    mov bh,al
  2153.                    in al,dx
  2154.                    mov bl,al
  2155.                    in al,dx
  2156.                    mov ah,al
  2157.                    mov al,0
  2158.                    dec dx
  2159.                    out dx,al
  2160. @1b:
  2161.                    mov dx,$3da
  2162. @4:                in al,dx
  2163.                    test al,1
  2164.                    jz @4
  2165.                    mov dx,$3c9
  2166.                    mov al,bh
  2167.                    out dx,al
  2168.                    mov al,bl
  2169.                    out dx,al
  2170.                    mov al,ah
  2171.                    out dx,al
  2172.                 END;
  2173.            END;
  2174.            SetColor(0,0,0,0);
  2175.            FOR I:=0 TO 79 DO
  2176.            BEGIN
  2177.                 IF K-320=I THEN
  2178.                    SetOffset(40);
  2179.                 Wait4Line;
  2180.            END;
  2181.            WaitRetrace;
  2182.            Inc(Phase);
  2183.            STI;
  2184.      UNTIL (Phase=2048-64) OR KeyCheck;
  2185.      SetWriteMap(15);
  2186.      ASM
  2187.         mov ax,0a000h
  2188.         mov es,ax
  2189.         xor di,di
  2190.         mov cx,8192
  2191.         db 66h
  2192.         xor ax,ax
  2193.         cld
  2194.         db 66h
  2195.         rep stosw
  2196.      END;
  2197. END;
  2198.  
  2199. { Phase V - Vertical Overlaying Sine Bars }
  2200.  
  2201. PROCEDURE PartV;
  2202. BEGIN
  2203.      SetStart(0);
  2204.      SetOffset(0);
  2205.      I:=0;
  2206.      FOR I:=1 TO 6 DO
  2207.          SetColor(I,I SHL 3+15,I SHL 3+15,0);
  2208.      Phase:=0;
  2209.      K:=0;
  2210.      Start:=0;
  2211.      Rechain;
  2212.      REPEAT
  2213.            CLI;
  2214.            IF Phase<200 THEN
  2215.               Inc(K,2)
  2216.            ELSE
  2217.            IF Phase>768-80 THEN
  2218.               Inc(Start);
  2219.            IF I>=1023 THEN
  2220.               I:=0
  2221.            ELSE Inc(I,4);
  2222.            SetStart(Start);
  2223.            SetOffset(0);
  2224.            WaitScreen;
  2225.            ASM
  2226.               mov ax,0a000h
  2227.               mov es,ax
  2228.               xor di,di
  2229.               mov cx,80
  2230.               db 66h
  2231.               xor ax,ax
  2232.               cld
  2233.               db 66h
  2234.               rep stosw
  2235.               mov si,i
  2236.               mov bx,si
  2237.            END;
  2238.            ASM
  2239.               mov cx,k
  2240.               cld
  2241.               mov dx,03dah
  2242. @1:           in al,dx
  2243.               test al,1
  2244.               jz @1
  2245.               mov di,word ptr [offset line+si]
  2246.               add di,word ptr [offset line2+bx]
  2247.               and di,7fffh
  2248.               add si,2
  2249.               and si,1023
  2250.               add bx,4
  2251.               and bx,1023
  2252. @1b:          mov ax,$0201
  2253.               stosw
  2254.               mov ax,$0403
  2255.               stosw
  2256.               mov ax,$0605
  2257.               stosw
  2258.               mov ax,$0506
  2259.               stosw
  2260. @2:           in al,dx
  2261.               test al,1
  2262.               jnz @2
  2263.               mov ax,$0304
  2264.               stosw
  2265.               mov ax,$0102
  2266.               stosw
  2267.               loop @1
  2268.            END;
  2269.            SetOffset(40);
  2270.            IF K<399 THEN
  2271.            BEGIN
  2272.                 Wait4Line;
  2273.                 SetOffset(0);
  2274.            END;
  2275.            WaitRetrace;
  2276.            Inc(Phase);
  2277.            STI;
  2278.      UNTIL (Phase=768) OR KeyCheck;
  2279. END;
  2280.  
  2281. { Part VI - Multi Scroller }
  2282.  
  2283. PROCEDURE PartVI;
  2284. VAR
  2285.    Ph:Integer;
  2286. BEGIN
  2287.      Init13X;
  2288.      SetPal(@StandardXPal^,256);
  2289.      SetLineRepeat(0);
  2290.      Start:=0;
  2291.      Ph:=127;
  2292.      Dir:=-1;
  2293.      Start:=0;
  2294.      Phase:=0;
  2295.      REPEAT
  2296.            CLI;
  2297.            FOR I:=0 TO 7 DO
  2298.            BEGIN
  2299.                 PutPartChar(319,1+I*62,Start AND 31,MultText[I,1+MultCount[I] SHR 5]);
  2300.                 Inc(MultCount[I]);
  2301.            END;
  2302.            SetHorizOfs(Start AND 3);
  2303.            SetStart(Start SHR 2);
  2304.            Inc(Start);
  2305.            SetOffset(0);
  2306.            VerticalRetrace;
  2307.            Wait4Line;
  2308.            Phase2:=Ph SHR 2;
  2309.            FOR I:=0 TO 7 DO
  2310.            BEGIN
  2311.                 ASM
  2312.                    mov cx,phase2
  2313.                    shl cl,1
  2314.                    mov ax,i
  2315.                    and ax,1
  2316.                    inc ax
  2317.                    xor bx,bx
  2318.                    rcr al,1
  2319.                    jnc @1
  2320.                    mov ah,cl
  2321. @1:                rcr al,1
  2322.                    jnc @2
  2323.                    mov bl,cl
  2324. @2:                rcr al,1
  2325.                    jnc @3
  2326.                    mov bh,cl
  2327. @3:                mov dx,03c8h
  2328.                    mov al,151
  2329.                    out dx,al
  2330.                    inc dx
  2331.                    mov al,ah
  2332.                    out dx,al
  2333.                    mov al,bl
  2334.                    out dx,al
  2335.                    mov al,bh
  2336.                    out dx,al
  2337.                 END;
  2338.                 ASM
  2339.                    mov si,phase2
  2340.                    shl si,5
  2341.                    add si,31
  2342.                    add si,offset multofstable
  2343.                    mov cx,32
  2344.                    std
  2345. @1:                lodsb
  2346.                    mov ah,al
  2347.                    mov al,13h
  2348.                    mov dx,03d4h
  2349.                    out dx,ax
  2350.                    or ah,ah
  2351.                    jnz @2
  2352.                    mov ax,i
  2353.                    or ax,ax
  2354.                    jnz @5
  2355. @2:                mov dx,03dah
  2356. @3:                in al,dx
  2357.                    test al,1
  2358.                    jnz @3
  2359. @4:                in al,dx
  2360.                    test al,1
  2361.                    jz @4
  2362. @5:                loop @1
  2363.                 END;
  2364.                 ASM
  2365.                    mov cx,32
  2366.                    inc si
  2367.                    cld
  2368. @1:                lodsb
  2369.                    mov ah,al
  2370.                    mov al,13h
  2371.                    mov dx,03d4h
  2372.                    out dx,ax
  2373.                    or ah,ah
  2374.                    jz @5
  2375.                    mov dx,03dah
  2376. @3:                in al,dx
  2377.                    test al,1
  2378.                    jnz @3
  2379. @4:                in al,dx
  2380.                    test al,1
  2381.                    jz @4
  2382. @5:                loop @1
  2383.                 END;
  2384.                 Phase2:=37-Phase2;
  2385.            END;
  2386.            SetOffset(40);
  2387.            Inc(Ph,Dir);
  2388.            IF (Ph=24) OR (Ph=127) THEN
  2389.               Dir:=-Dir;
  2390.            Inc(Phase);
  2391.            STI;
  2392.      UNTIL (Phase=2048+384) OR KeyCheck;
  2393. END;
  2394.  
  2395. { Part VII - Plasma }
  2396.  
  2397. PROCEDURE PartVII;
  2398. BEGIN
  2399.      SetStart(0);
  2400.      FOR I:=0 TO 255 DO
  2401.          SetColor(I,0,0,0);
  2402.      FOR I:=0 TO 63 DO
  2403.      BEGIN
  2404.           SetColor(128+I,I,0,0);
  2405.           SetColor(255-I,I,0,0);
  2406.      END;
  2407.      SetOffset(80);
  2408.      SwitchOff;
  2409.      FOR I:=30 TO 609 DO
  2410.      BEGIN
  2411.           Adr:=I SHR 2;
  2412.           SetWriteMap(1 SHL (I AND 3));
  2413.           ASM
  2414.              mov ax,0a000h
  2415.              mov es,ax
  2416.              mov di,adr
  2417.           END;
  2418.           FOR J:=0 TO 399 DO
  2419.           BEGIN
  2420.                ASM
  2421.                   mov si,offset sintable
  2422.                   xor ax,ax
  2423.                   mov bx,i
  2424.                   shr bx,1
  2425.                   mov bh,0
  2426.                   mov al,[bx+si]
  2427.                   mov bx,j
  2428.                   shr bx,2
  2429.                   mov bh,0
  2430.                   add al,[bx+si]
  2431.                   mov bx,i
  2432.                   add bx,j
  2433.                   shr bx,1
  2434.                   mov bh,0
  2435.                   add al,[bx+si]
  2436.                   mov bx,j
  2437.                   shl bx,1
  2438.                   mov bh,0
  2439.                   add al,[bx+si]
  2440.                   push ax
  2441.                   mov bx,i
  2442.                   sub bx,j
  2443.                   sar bx,1
  2444.                   mov bh,0
  2445.                   mov dl,[bx+si]
  2446.                   mov bx,j
  2447.                   shr bx,1
  2448.                   mov bh,0
  2449.                   add dl,[bx+si]
  2450.                   push dx
  2451.                   mov bx,639
  2452.                   sub bx,i
  2453.                   mov ax,j
  2454.                   mul bx
  2455.                   shr ax,7
  2456.                   mov bx,ax
  2457.                   mov bh,0
  2458.                   pop dx
  2459.                   add dl,[bx+si]
  2460.                   push dx
  2461.                   mov ax,i
  2462.                   xor dx,dx
  2463.                   mov bx,j
  2464.                   inc bx
  2465.                   div bx
  2466.                   shr ax,5
  2467.                   mov bx,ax
  2468.                   mov bh,0
  2469.                   pop dx
  2470.                   add dl,[bx+si]
  2471.                   mov dh,0
  2472.                   pop ax
  2473.                   add ax,dx
  2474.                   shr ax,1
  2475.                   and al,127
  2476.                   add al,128
  2477.                   stosb
  2478.                   add di,159
  2479.                END;
  2480.           END;
  2481.      END;
  2482.      Unchain;
  2483.      SwitchOn;
  2484.      J:=0;
  2485.      Start:=0;
  2486.      Dir:=1;
  2487.      SetStart(40);
  2488.      Phase:=0;
  2489.      REPEAT
  2490.            CLI;
  2491.            DrawPlasma;
  2492.            Inc(Start,Dir);
  2493.            IF (Start=0) OR (Start=1023) THEN
  2494.               Dir:=-Dir;
  2495.            Inc(J,2);
  2496.            IF J>127 THEN
  2497.               J:=0;
  2498.            STI;
  2499.            Inc(Phase);
  2500.      UNTIL (Phase=1024) OR KeyCheck;
  2501. END;
  2502.  
  2503. { Part VIII - Big Zoom of Ball, 32x32 }
  2504.  
  2505. PROCEDURE PartVIII;
  2506. BEGIN
  2507.      SetModeNr($0D);
  2508.      Init16Pal;
  2509.      SetPal(BallPal,256);
  2510.      SetOffset(0);
  2511.      Factor:=16;
  2512.      Dir:=2;
  2513.      Phase:=0;
  2514.      REPEAT
  2515.            CLI;
  2516.            IF Phase AND 511<118 THEN
  2517.               Factor:=16+Byte(Phase) SHL 1
  2518.            ELSE
  2519.            IF Phase AND 511<394 THEN
  2520.               Factor:=250
  2521.            ELSE Factor:=250-(Phase-394) SHL 1;
  2522.            PutLine(Factor);
  2523.            X:=SinTab[Byte(Phase)]+64;
  2524.            SetHorizOfs(X AND 3);
  2525.            SetStart(X SHR 2);
  2526.            Y:=CosTab[Byte(Phase)];
  2527.            Y:=Y*Factor;
  2528.            SetOffset(0);
  2529.            WaitScreen;
  2530.            DrawFrame;
  2531.            WaitRetrace;
  2532.            SetOffset(40);
  2533.            Inc(Factor,Dir);
  2534.            IF (Factor=16) OR (Factor=250) THEN
  2535.               Dir:=-Dir;
  2536.            Inc(Phase);
  2537.            STI;
  2538.      UNTIL (Phase=768) OR KeyCheck;
  2539. END;
  2540.  
  2541. { Part IX - Animated Zoom, 16x16 }
  2542.  
  2543. PROCEDURE PartIX;
  2544. BEGIN
  2545.      Factor:=16;
  2546.      Dir:=1;
  2547.      Phase:=0;
  2548.      SetOffset(0);
  2549.      REPEAT
  2550.            CLI;
  2551.            IF Byte(Phase)<111 THEN
  2552.               Factor:=126-Byte(Phase)
  2553.            ELSE
  2554.            IF Byte(Phase)<222 THEN
  2555.               Factor:=16+Byte(Phase)-111
  2556.            ELSE Factor:=127;
  2557.            PutLine2(Factor);
  2558.            X:=SinTab[Byte(Phase)]+64;
  2559.            SetHorizOfs(X AND 3);
  2560.            SetStart(X SHR 2);
  2561.            Y:=CosTab[Byte(Phase)];
  2562.            Y:=Y*Factor;
  2563.            WaitScreen;
  2564.            DrawFrame2;
  2565.            WaitRetrace;
  2566.            Inc(Phase);
  2567.            STI;
  2568.      UNTIL (Phase=1024) OR KeyCheck;
  2569. END;
  2570.  
  2571. { Part X - Overlaying Checkers }
  2572.  
  2573. PROCEDURE PartX;
  2574. BEGIN
  2575.      FOR J:=0 TO 7 DO
  2576.          FOR I:=0 TO 15 DO
  2577.          BEGIN
  2578.               IF (I AND 1=1) XOR (J AND 1=1) THEN
  2579.                  R:=63
  2580.               ELSE R:=0;
  2581.               IF (I AND 2=2) XOR (J AND 2=2) THEN
  2582.                  G:=63
  2583.               ELSE G:=0;
  2584.               IF (I AND 4=4) XOR (J AND 4=4) THEN
  2585.                  B:=63
  2586.               ELSE B:=0;
  2587.               SetColor(J SHL 4+I,R,G,B);
  2588.          END;
  2589.      SetStart(0);
  2590.      SetHorizOfs(0);
  2591.      FOR I:=0 TO 15 DO
  2592.          SetColor(128+I,0,0,0);
  2593.      StartMap:=0;
  2594.      EndMap:=1;
  2595.      SetOffset(0);
  2596.      Phase:=0;
  2597.      REPEAT
  2598.            CLI;
  2599.            PalSel:=0;
  2600.            FOR I:=StartMap TO EndMap-1 DO
  2601.                YCount[I]:=CheckerSinTab[PhaseX[I]]-200;
  2602.            FOR I:=StartMap TO EndMap-1 DO
  2603.            BEGIN
  2604.                 WHILE YCount[I]>SizeX[I] SHL 2 DO
  2605.                       Dec(YCount[I],SizeX[I] SHL 2);
  2606.                 WHILE YCount[I]<0 DO
  2607.                       Inc(YCount[I],SizeX[I] SHL 2);
  2608.                 IF YCount[I]>SizeX[I] SHL 1 THEN
  2609.                 BEGIN
  2610.                      Dec(YCount[I],SizeX[I] SHL 1);
  2611.                      PalSel:=PalSel XOR (1 SHL I);
  2612.                 END;
  2613.            END;
  2614.            WaitScreen;
  2615.            FOR J:=0 TO 359 DO
  2616.            BEGIN
  2617.                 ASM
  2618.                    mov bx,offset ycount
  2619.                    mov si,offset sizex
  2620.                    cld
  2621.                    lodsw
  2622.                    shl ax,1
  2623.                    mov dx,[bx]
  2624.                    cmp startmap,0
  2625.                    jg @1a
  2626.                    cmp ax,dx
  2627.                    jnz @1
  2628.                    xor byte ptr palsel,1
  2629.                    mov word ptr [bx],0
  2630. @1:                inc word ptr [bx]
  2631.                    cmp endmap,1
  2632.                    jz @4
  2633.  
  2634. @1a:               add bx,2
  2635.  
  2636.                    lodsw
  2637.                    shl ax,1
  2638.                    mov dx,[bx]
  2639.                    cmp startmap,1
  2640.                    jg @2a
  2641.                    cmp ax,dx
  2642.                    jnz @2
  2643.                    xor byte ptr palsel,2
  2644.                    mov word ptr [bx],0
  2645. @2:                inc word ptr [bx]
  2646.                    cmp endmap,2
  2647.                    jz @4
  2648.  
  2649. @2a:               add bx,2
  2650.  
  2651.                    lodsw
  2652.                    shl ax,1
  2653.                    mov dx,[bx]
  2654.                    cmp ax,dx
  2655.                    jnz @3
  2656.                    xor byte ptr palsel,4
  2657.                    mov word ptr [bx],0
  2658. @3:                inc word ptr [bx]
  2659.                    add bx,2
  2660. @4:
  2661.                 END;
  2662.                 ASM
  2663.                    mov dx,03c0h
  2664.                    mov al,34h
  2665.                    out dx,al
  2666.                    mov al,palsel
  2667.                    out dx,al
  2668.  
  2669.                    mov dx,03dah
  2670. @1:                in al,dx
  2671.                    test al,1
  2672.                    jnz @1
  2673. @2:                in al,dx
  2674.                    test al,1
  2675.                    jz @2
  2676.                 END;
  2677.            END;
  2678.            Set16Pal(8);
  2679.            WaitRetrace;
  2680.            FOR I:=StartMap TO EndMap-1 DO
  2681.            BEGIN
  2682.                 Inc(SizeX[I],DirX[I]);
  2683.                 IF (SizeX[I]=16) AND (DirX[I]=-1) OR (SizeX[I]=127) THEN
  2684.                    DirX[I]:=-DirX[I];
  2685.            END;
  2686.            FOR I:=StartMap TO EndMap-1 DO
  2687.            BEGIN
  2688.                 ASM
  2689.                    mov cx,i
  2690.                    mov ah,1
  2691.                    shl ah,cl
  2692.                    mov al,2
  2693.                    mov dx,03c4h
  2694.                    out dx,ax
  2695.                 END;
  2696.                 XCountCurr:=CheckerCosTab[PhaseX[I]]-160;
  2697.                 ASM
  2698.                    mov si,i
  2699.                    shl si,1
  2700.                    add si,offset sizex
  2701.                    lodsw
  2702.                    shl ax,1
  2703.                    mov bx,xcountcurr
  2704. @1:                cmp bx,ax
  2705.                    jle @2
  2706.                    sub bx,ax
  2707.                    jmp @1
  2708. @2:                or bx,bx
  2709.                    jge @3
  2710.                    add bx,ax
  2711.                    jmp @2
  2712. @3:                xor dx,dx
  2713.                    shr ax,1
  2714.                    cmp bx,ax
  2715.                    jle @4
  2716.                    sub bx,ax
  2717.                    inc dx
  2718. @4:                mov si,ax
  2719.                 END;
  2720.                 ASM
  2721.                    mov ax,0a000h
  2722.                    mov es,ax
  2723.                    xor di,di
  2724.                    mov dh,20
  2725.                    cld
  2726. @0:                xor ax,ax
  2727.                    mov cx,16
  2728. @1:                shl ax,1
  2729.                    or al,dl
  2730.                    cmp bx,si
  2731.                    jnz @2
  2732.                    xor bx,bx
  2733.                    xor dl,1
  2734. @2:                inc bx
  2735.                    loop @1
  2736.                    xchg al,ah
  2737.                    stosw
  2738.                    dec dh
  2739.                    jnz @0
  2740.                 END;
  2741.            END;
  2742.            FOR I:=EndMap TO 2 DO
  2743.            BEGIN
  2744.                 SetWriteMap(1 SHL I);
  2745.                 ASM
  2746.                    mov ax,0a000h
  2747.                    mov es,ax
  2748.                    xor di,di
  2749.                    mov cx,10
  2750.                    db 66h
  2751.                    xor ax,ax
  2752.                    cld
  2753.                    db 66h
  2754.                    rep stosw
  2755.                 END;
  2756.            END;
  2757.            FOR I:=0 TO StartMap-1 DO
  2758.            BEGIN
  2759.                 SetWriteMap(1 SHL I);
  2760.                 ASM
  2761.                    mov ax,0a000h
  2762.                    mov es,ax
  2763.                    xor di,di
  2764.                    mov cx,10
  2765.                    db 66h
  2766.                    xor ax,ax
  2767.                    cld
  2768.                    db 66h
  2769.                    rep stosw
  2770.                 END;
  2771.            END;
  2772.            FOR I:=0 TO 2 DO
  2773.            BEGIN
  2774.                 IF PhaseX[I]=128 THEN
  2775.                    PhaseX[I]:=0
  2776.                 ELSE Inc(PhaseX[I]);
  2777.            END;
  2778.            Inc(Phase);
  2779.            IF Phase=512 THEN
  2780.               EndMap:=2
  2781.            ELSE
  2782.            IF Phase=1024 THEN
  2783.               EndMap:=3
  2784.            ELSE
  2785.            IF Phase=1536 THEN
  2786.               StartMap:=1
  2787.            ELSE
  2788.            IF Phase=2048 THEN
  2789.               StartMap:=2;
  2790.            STI;
  2791.      UNTIL (Phase=2048+256) OR KeyCheck;
  2792. END;
  2793.  
  2794. { Part XI - Screen wobbler }
  2795.  
  2796. PROCEDURE PartXI;
  2797. BEGIN
  2798.      Init13X;
  2799.      SwitchOff;
  2800.      SetPal(@AardCpFkPal^,256);
  2801.      SetLineRepeat(0);
  2802.      Spr:=@AardCpFkSpr;
  2803.      SetColor(0,0,0,0);
  2804.      FOR I:=0 TO 3 DO
  2805.      BEGIN
  2806.           SetWriteMap(1 SHL I);
  2807.           ASM
  2808.              push ds
  2809.              mov ax,0a000h
  2810.              mov es,ax
  2811.              mov ax,i
  2812.              lds si,spr
  2813.              add si,ax
  2814.              add si,4
  2815.              mov dx,198
  2816.              cld
  2817. @1:          mov di,050h
  2818.              mov cx,80
  2819. @2:          movsb
  2820.              add si,3
  2821.              loop @2
  2822.              sub si,320
  2823.              mov cx,80
  2824. @3:          movsb
  2825.              add si,3
  2826.              loop @3
  2827.              mov ax,es
  2828.              add ax,0ah
  2829.              mov es,ax
  2830.              dec dx
  2831.              jnz @1
  2832.              pop ds
  2833.           END;
  2834.      END;
  2835.      FOR I:=0 TO 3 DO
  2836.      BEGIN
  2837.           SetWriteMap(1 SHL I);
  2838.           ASM
  2839.              push ds
  2840.              mov ax,0afb7h
  2841.              mov es,ax
  2842.              mov ax,i
  2843.              lds si,spr
  2844.              add si,ax
  2845.              add si,4
  2846.              mov dx,198
  2847.              cld
  2848. @1:          mov di,050h
  2849.              mov cx,80
  2850. @2:          movsb
  2851.              add si,3
  2852.              loop @2
  2853.              sub si,320
  2854.              mov cx,80
  2855. @3:          movsb
  2856.              add si,3
  2857.              loop @3
  2858.              mov ax,es
  2859.              sub ax,0ah
  2860.              mov es,ax
  2861.              dec dx
  2862.              jnz @1
  2863.              pop ds
  2864.           END;
  2865.      END;
  2866.      Port[$3D4]:=$11;
  2867.      Port[$3D5]:=Port[$3D5] AND $7F;
  2868.      SwitchOn;
  2869.      Phase:=0;
  2870.      K:=0;
  2871.      REPEAT
  2872.            CLI;
  2873.            VerticalRetrace;
  2874.            J:=(Phase MOD 200) SHL 1;
  2875.            IF Phase<63 THEN
  2876.               Inc(K)
  2877.            ELSE
  2878.            IF Phase>448 THEN
  2879.               Dec(K);
  2880.            ASM
  2881.               mov si,offset displaystart
  2882.               add si,j
  2883.               mov cx,280
  2884.               cld
  2885. @0:           lodsb
  2886.               cbw
  2887.               mov bx,k
  2888.               imul bx
  2889.               add ah,86
  2890.               mov dx,03dah
  2891. @1:           in al,dx
  2892.               test al,1
  2893.               jnz @1
  2894.               mov dx,03d4h
  2895.               mov al,4
  2896.               out dx,ax
  2897.               mov dx,03dah
  2898. @2:           in al,dx
  2899.               test al,1
  2900.               jz @2
  2901.               loop @0
  2902.            END;
  2903.            Inc(Phase);
  2904.            STI;
  2905.      UNTIL (Phase=512) OR KeyCheck;
  2906. END;
  2907.  
  2908. { Part XII - Screen rotate off }
  2909.  
  2910. PROCEDURE PartXII;
  2911. BEGIN
  2912.      I:=199;
  2913.      Dir:=-1;
  2914.      Adr:=0;
  2915.      Phase:=0;
  2916.      REPEAT
  2917.            CLI;
  2918.            IF I>=34 THEN
  2919.               ShowPicture
  2920.            ELSE
  2921.            IF (I=33) AND (Dir=-1) THEN
  2922.            BEGIN
  2923.                 Adr:=$8000-Adr;
  2924.                 SetStart(Adr);
  2925.            END
  2926.            ELSE VerticalRetrace;
  2927.            Inc(I,Dir);
  2928.            IF (I=1) OR (I=199) THEN
  2929.               Dir:=-Dir;
  2930.            Inc(Phase);
  2931.            STI;
  2932.      UNTIL (Phase=970) OR KeyCheck;
  2933. END;
  2934.  
  2935. { Part XIII - Roundscroller with Greetings }
  2936.  
  2937. PROCEDURE PartXIII;
  2938. BEGIN
  2939.      ClearScreen;
  2940.      MCGAOn;
  2941.      SetModeReg('256X400',@R256X400Reg^);
  2942.      Unchain;
  2943.      FOR I:=0 TO 15 DO
  2944.          SetColor(I,31,I SHL 2,I SHL 2);
  2945.      Phase:=0;
  2946.      K:=0;
  2947.      VerticalRetrace;
  2948.      REPEAT
  2949.            CLI;
  2950.            SetColor(0,0,0,0);
  2951.            ASM
  2952.               mov bx,phase
  2953.               shl bx,7
  2954.               mov dx,03d4h
  2955.               mov al,0ch
  2956.               mov ah,bh
  2957.               out dx,ax
  2958.               inc ax
  2959.               mov ah,bl
  2960.               out dx,ax
  2961.  
  2962.               mov dx,03dah
  2963. @2:           in al,dx
  2964.               test al,8
  2965.               jnz @2
  2966.            END;
  2967.            ASM
  2968.               mov cx,400
  2969.               xor si,si
  2970.               cld
  2971.  
  2972. @0:           mov dx,03c8h
  2973.               mov al,0
  2974.               out dx,al
  2975.               inc dx
  2976.               push si
  2977.               add si,offset colortab
  2978.               lodsb
  2979.               mul byte ptr k
  2980.               mov al,ah
  2981.               out dx,al
  2982.               mov al,0
  2983.               out dx,al
  2984.               out dx,al
  2985.  
  2986.               mov dx,03dah
  2987. @1:           in al,dx
  2988.               test al,1
  2989.               jnz @1
  2990.  
  2991.               mov dx,03d4h
  2992.               mov al,13h
  2993.               pop si
  2994.               push si
  2995.               add si,offset gaptab
  2996.               mov ah,[si]
  2997.               out dx,ax
  2998.  
  2999.               mov dx,03dah
  3000. @2:           in al,dx
  3001.               test al,1
  3002.               jz @2
  3003.  
  3004.               pop si
  3005.               inc si
  3006.               loop @0
  3007.            END;
  3008.            SetColor(0,0,0,0);
  3009.            FOR I:=0 TO 15 DO
  3010.                ASM
  3011.                   cld
  3012.                   push ds
  3013.                   pop es
  3014.                   mov di,offset linedata
  3015.                   mov bx,i
  3016.                   shl bx,2
  3017.                   mov si,phase
  3018.                   push si
  3019.                   shr si,4
  3020.                   shl si,4
  3021.                   add si,i
  3022.                   add si,offset textdata
  3023.                   lodsb
  3024.                   mov ah,0
  3025.                   shl ax,2
  3026.                   mov si,offset fontch+2048
  3027.                   add si,ax
  3028.                   lds si,[si]
  3029.                   pop ax
  3030.                   and ax,15
  3031.                   shl ax,4
  3032.                   add ax,4
  3033.                   add si,ax
  3034.                   mov cx,16
  3035. @1:               lodsb
  3036.                   mov es:[di+bx],al
  3037.                   add bl,64
  3038.                   adc bl,0
  3039.                   loop @1
  3040.                   push es
  3041.                   pop ds
  3042.                END;
  3043.            FOR L:=0 TO 1 DO
  3044.            BEGIN
  3045.                 IF Tseng THEN
  3046.                    ASM
  3047.                       mov dx,03cdh
  3048.                       mov al,l
  3049.                       out dx,al
  3050.                    END;
  3051.                 FOR I:=0 TO 1 DO
  3052.                     ASM
  3053.                        mov ax,0a000h
  3054.                        mov es,ax
  3055.                        mov di,phase
  3056.                        shl di,1
  3057.                        add di,i
  3058.                        shl di,6
  3059.                        add di,0c000h
  3060.                        mov bx,di
  3061.                        mov si,offset linedata
  3062.                        mov dx,03c4h
  3063.                        cld
  3064.                        mov ax,0102h
  3065.                        out dx,ax
  3066.                        mov cx,16
  3067.                        db 66h
  3068.                        rep movsw
  3069.                        mov ax,0202h
  3070.                        out dx,ax
  3071.                        mov cx,16
  3072.                        mov di,bx
  3073.                        db 66h
  3074.                        rep movsw
  3075.                        mov ax,0402h
  3076.                        out dx,ax
  3077.                        mov cx,16
  3078.                        mov di,bx
  3079.                        db 66h
  3080.                        rep movsw
  3081.                        mov ax,0802h
  3082.                        out dx,ax
  3083.                        mov cx,16
  3084.                        mov di,bx
  3085.                        db 66h
  3086.                        rep movsw
  3087.                     END;
  3088.            END;
  3089.            Inc(Phase);
  3090.            IF Phase<255 THEN
  3091.               Inc(K)
  3092.            ELSE
  3093.            IF Phase=5696-256 THEN
  3094.               Dec(K);
  3095.            STI;
  3096.      UNTIL (Phase=5696) OR KeyCheck;
  3097. END;
  3098.  
  3099. FUNCTION CheckForVGA:Boolean;
  3100. BEGIN
  3101.      ASM
  3102.         xor bx,bx
  3103.         mov ax,01a00h
  3104.         int 10h
  3105.         cmp bl,7
  3106.         jb @1
  3107.         cmp bl,0ch
  3108.         ja @1
  3109.         mov @result,true
  3110.         jmp @2
  3111. @1:     mov @result,false
  3112. @2:
  3113.      END;
  3114. END;
  3115.  
  3116. FUNCTION CheckFor386:Boolean;
  3117. BEGIN
  3118.      ASM
  3119.         pushf
  3120.         xor ah,ah
  3121.         push ax
  3122.         popf
  3123.         pushf
  3124.         pop ax
  3125.         and ah,0f0h
  3126.         cmp ah,0f0h
  3127.         je @1
  3128.         mov ah,0f0h
  3129.         push ax
  3130.         popf
  3131.         pushf
  3132.         pop ax
  3133.         and ah,0f0h
  3134.         jz @1
  3135.         popf
  3136.         mov @result,true
  3137.         jmp @2
  3138. @1:     mov @result,false
  3139. @2:
  3140.      END;
  3141. END;
  3142.  
  3143. FUNCTION CheckForVirtual:Boolean;
  3144. BEGIN
  3145.      ASM
  3146.         smsw ax
  3147.         test al,1
  3148.         jz @1
  3149.         mov @result,true
  3150.         jmp @2
  3151. @1:     mov @result,false
  3152. @2:
  3153.      END;
  3154. END;
  3155.  
  3156. PROCEDURE DetectTseng;
  3157. VAR
  3158.    Dummy,OldValue,NewValue,Value:Byte;
  3159. BEGIN
  3160.      Port[$3BF]:=3;
  3161.      IF Port[$3CC] AND 1=1 THEN
  3162.         Port[$3D8]:=$A0
  3163.      ELSE Port[$3B8]:=$A0;
  3164.      Dummy:=Port[$3DA];
  3165.      Port[$3C0]:=$16;
  3166.      OldValue:=Port[$3C1];
  3167.      Dummy:=Port[$3DA];
  3168.      Port[$3C0]:=$16;
  3169.      NewValue:=OldValue XOR $10;
  3170.      Port[$3C0]:=NewValue;
  3171.      Dummy:=Port[$3DA];
  3172.      Port[$3C0]:=$16;
  3173.      Value:=Port[$3C1];
  3174.      Dummy:=Port[$3DA];
  3175.      Port[$3C0]:=$16;
  3176.      Port[$3C0]:=OldValue;
  3177.      Tseng:=Value=NewValue;
  3178. END;
  3179.  
  3180. PROCEDURE CheckIt;
  3181. BEGIN
  3182.      Write('Detecting available memory ... ');
  3183.      InitPartII;
  3184.      InitPartIV;
  3185.      InitPartV;
  3186.      InitPartVII;
  3187.      InitPartX;
  3188.      IF MemAvail>160000 THEN
  3189.         WriteLn(' Ok, ',MemAvail-160000,' bytes more than needed.')
  3190.      ELSE
  3191.      BEGIN
  3192.           WriteLn(' not enough found! About',160000-MemAvail,' bytes more needed to run this.',#7);
  3193.           Halt(3);
  3194.      END;
  3195.      Write('Detecting VGA ... ');
  3196.      InitPartI;
  3197.      InitPartVI;
  3198.      IF CheckForVGA THEN
  3199.         WriteLn('Ok.')
  3200.      ELSE
  3201.      BEGIN
  3202.           WriteLn('not found! You need a VGA card to run this.',#7);
  3203.           Halt(1);
  3204.      END;
  3205.      Write('Detecting 386 ... ');
  3206.      InitPartVIII;
  3207.      IF CheckFor386 THEN
  3208.         WriteLn('Ok.')
  3209.      ELSE
  3210.      BEGIN
  3211.           WriteLn('not found! You need at least a 386 processor to run this.',#7);
  3212.           Halt(2);
  3213.      END;
  3214.      Write('Detecting processor mode ... ');
  3215.      InitPartIX;
  3216.      IF CheckForVirtual THEN
  3217.         WriteLn(' Ok, running in V8086 mode.')
  3218.      ELSE WriteLn(' Ok, running in native 80386 mode.');
  3219.      InitPartXI;
  3220.      InitPartXIII;
  3221.      DetectTseng;
  3222. END;
  3223.  
  3224. BEGIN
  3225.      ASM
  3226.         mov ax,3
  3227.         int $10
  3228.      END;
  3229.      CheckIt;
  3230.      FOR I:=0 TO 127 DO
  3231.          Key[I]:=FALSE;
  3232.      Pressed:=FALSE;
  3233.      GetIntVec($09,SaveInt09);
  3234.      SetIntVec($09,@NewInt09);
  3235.      IF ParamCount<>0 THEN
  3236.         Val(ParamStr(1),BeginPart,I)
  3237.      ELSE BeginPart:=0;
  3238.      PartI;
  3239.      PartII;
  3240.      PartIII;
  3241.      PartIV;
  3242.      PartV;
  3243.      PartVI;
  3244.      PartVII;
  3245.      PartVIII;
  3246.      PartIX;
  3247.      PartX;
  3248.      PartXI;
  3249.      PartXII;
  3250.      PartXIII;
  3251.      EndDemo;
  3252. END.
  3253.